Functional Perl Programming

my $item = "a single item";
my @array = ("one", "two", "many", "items"); # ordered list
my %hash = ( x => "y", a => '1' );           # key-value pairs

my $array_ref = \@array;
my $hash_ref = \%hash;

sub my_function {
    my $input = shift;
    "return $input as part of a string";
}

my $code_ref = \&my_function;

use feature 'say';              # like `print`, but with trailing newline
say my_function($item);
say my_function($array_ref);
say $code_ref->($hash_ref);

sub factorial {
    my $n = shift;              # accepts a number
    return 1 if $n == 1;        # stop recursing on this condition
    $n * factorial( $n - 1 );   # otherwise do it
}

use feature 'say';
say factorial(5);
say factorial(10);

sub factorial_r {
    my $n = shift;
    return 1 if $n == 1;
    $n * factorial_r( $n - 1 );
}

sub factorial_i {
    my $n = shift;
    $n *= $n - 1 for reverse 1 .. $n;
    $n;
}

use Benchmark 'cmpthese';
cmpthese(
    1000000,
    {   recursive => 'factorial_r(10)',
        iterative => 'factorial_i(10)',
    }
);

# I'm lazy, use a web framework!
use Mojolicious::Lite;

sub index {
    my $c = shift;
    $c->render( text => "You've reached the index." );
}

get '/' => \&index;

# "sub { ... }" is an anonymous code ref
get '/:foo' => sub {
    my $c   = shift;
    my $foo = $c->param('foo');
    $c->render( text => "Hello from $foo!" );
};

app->start;

use feature 'say';
use File::Find;

sub wanted {
    # predicate/filter for files to search
    /.*zakame.*/ &&           # find files with `zakame` in the name
        int( -M _ ) > 2 &&    # that's older than 2 days
        say;
}

# search the wastebasket
find( \&wanted, '/tmp' );

$count = 1;                  # a global variable

# explicitly make a new scope with a block:
{
    my $count = 1;              # a lexically-scoped variable
    sub counter { $count++ }    # a closure incrementing my $count
}

use feature 'say';
say "lexical variable \$count = ", counter for 1..3;
say "global variable \$count = $count";

sub make_bean_counter {
    my ( $start, $callback ) = @_; # accept a starting value and a callback
    sub {
        # return a new function that increments and calls back
        $start++;
        $callback->($start);
    };
}

my $from_ten = make_bean_counter( 10, sub { print $_[0], "\n"; } );
$from_ten->() for 1..3;         # go from 10 to 13

my $sum;
sub accumulate {
    $sum += $_[0]
}
my $from_50 = make_bean_counter( 50, \&accumulate );
$from_50->() for 1..5;          # total from 51 to 55
print $sum;

use HTTP::Status ':constants';
my $app = sub {
    my $env = shift;
    +[  HTTP_OK,
        [ 'Content-Type' => 'text/html' ],
        ["Hello, $env->{REMOTE_ADDR}"]
    ];
};

use Plack::Builder;
builder {
    # external middleware currying the pipeline to $app
    enable "Debug", panels => [qw(Memory Timer)];

    # inline middle doing explicit currying
    enable sub {
        my $app = shift;
        sub {
            my $env = shift;
            # override REMOTE_ADDR
            $env->{REMOTE_ADDR} = '67.202.105.161';
            $app->($env);
        };
    };
    $app;
};

use HOP::Lexer 'make_lexer';
my @sql   = $sql;
my $lexer = make_lexer(
    sub { shift @sql },
    [ 'KEYWORD', qr/(?i:select|from|as)/          ],
    [ 'COMMA',   qr/,/                            ],
    [ 'OP',      qr{[-=+*/]}                      ],
    [ 'PAREN',   qr/\(/,      sub { [shift,  1] } ],
    [ 'PAREN',   qr/\)/,      sub { [shift, -1] } ],
    [ 'TEXT',    qr/(?:\w+|'\w+'|"\w+")/, \&text  ],
    [ 'SPACE',   qr/\s*/,     sub {}              ],
);

sub text {
    my ($label, $value) = @_;
    $value =~ s/^["']//;
    $value =~ s/["']$//;
    return [ $label, $value ];
}

package My::Hashids;
use Moo;
use Carp;

# A salt is needed to initialize the Hashids encoder
has salt => ( is => 'ro', default => '');

# A minimum hash length is also needed
has minHashLength => (
    is => 'ro',
    isa => sub {
        croak "$_[0] is not a number!" unless $_[0] =~ /^\d+$/;
    },
    default => 0,
);

has alphabet => (
    is => 'rw',
    default => sub { join '' => 'a' .. 'z', 'A' .. 'Z' },
);