sub make_suffix_appender { my $suffix = shift; return sub { return $_[0] . $suffix; } } #### my $bang_appender = make_suffix_appender("!"); print $bang_appender->("Hello"); # Hello! print $bang_appender->("Dude"); # Dude! #### sub apply { my $fn = shift; return sub { $fn->(@_); } } sub apply_to_each { my $fn = shift; return sub { map { $fn->($_) } @_; } } #### my $upcase = apply( sub { uc("@_") } ); print $upcase->("Hello"); # HELLO print $upcase->("Hello", "world"); # HELLO WORLD my $parenify_all = apply( sub { "(@_)" } ); my $parenify_each = apply_to_each( $parenify_all ); print $parenify_all ->("Hello", "world"); # (Hello world) print $parenify_each->("Hello", "world"); # (Hello)(world) #### sub make_regex_matcher { my $regex = shift; return sub { local $_ = $_[0]; /$regex/g; } } #### my $digit_matcher = make_regex_matcher( qr/(\d+)/ ); my @digits = $digit_matcher->( "123-blah-45-6789" ); print "@digits"; # 123 45 6789 my $word_matcher = make_regex_matcher( qr/(\w+)/ ); my @words = $word_matcher->( "123-blah-45-6789" ); print "@words"; # 123 blah 45 6789 #### sub compose2 { my ($f, $g) = @_; return sub { $f->( $g->( @_ ) ); } }; use List::Util qw( reduce ); sub compose { no warnings qw( once ); reduce { compose2($a,$b) } @_; } #### my $up_banger = compose($bang_appender, $upcase); print $up_banger->("Hello"); # HELLO! my $upcase_words = compose($upcase, $word_matcher); print $upcase_words->( "123-blah-45-6789" ); # 123 BLAH 45 6789 my $parenify_words = compose($parenify_each, $word_matcher); print $parenify_words->( "123-blah-45-6789" ); # (123)(blah)(45)(6789) #### print compose($parenify_each, $word_matcher)->("a b c"); # (a)(b)(c) #### print compose($word_matcher, $parenify_each)->("a b c"); # abc #### my $id = sub { wantarray ? @_ : $_[0] }; #### my $fs = 0; for my $f ($id, $parenify_all, $parenify_each) { my $fd = (qw( id- pAl pEa ))[$fs++]; my $gs = 0; for my $g ($id, $word_matcher, $digit_matcher) { my $gd = (qw( id- wrd dig ))[$gs++]; my $hs = 0; for my $h ($id, $upcase, $bang_appender) { my $hd = (qw( id- up- bng ))[$hs++]; print "$fd-$gd-$hd: ", compose($f,$g,$h)->("Eat more 3.14"); } } } #### id--id--id-: Eat more 3.14 id--id--up-: EAT MORE 3.14 id--id--bng: Eat more 3.14! id--wrd-id-: Eatmore314 id--wrd-up-: EATMORE314 id--wrd-bng: Eatmore314 id--dig-id-: 314 id--dig-up-: 314 id--dig-bng: 314 pAl-id--id-: (Eat more 3.14) pAl-id--up-: (EAT MORE 3.14) pAl-id--bng: (Eat more 3.14!) pAl-wrd-id-: (Eat more 3 14) pAl-wrd-up-: (EAT MORE 3 14) pAl-wrd-bng: (Eat more 3 14) pAl-dig-id-: (3 14) pAl-dig-up-: (3 14) pAl-dig-bng: (3 14) pEa-id--id-: (Eat more 3.14) pEa-id--up-: (EAT MORE 3.14) pEa-id--bng: (Eat more 3.14!) pEa-wrd-id-: (Eat)(more)(3)(14) pEa-wrd-up-: (EAT)(MORE)(3)(14) pEa-wrd-bng: (Eat)(more)(3)(14) pEa-dig-id-: (3)(14) pEa-dig-up-: (3)(14) pEa-dig-bng: (3)(14)