method-with-block.t

#!perl -w
use strict;
use Test::More;

#my $tests = 0;
#sub is{
#    my($got, $expected) = @_;
#    print $got eq $expected ? 'ok ' : 'not ok ';
#    print ++$tests, "\n";
#}

sub C::method{
    return [@_];
}
my $m = 'method';
my $args;

# INVOCANT->METHOD ARGS BLOCK

$args = C->method(1){ 30 };
is scalar(@$args), 3;
is $args->[0], 'C';
is $args->[1], 1;
is ref($args->[2]), 'CODE';
is $args->[2]->(), 30;

$args = C->method(1 .. 10){ 40 };
is scalar(@$args), 12;
is $args->[0], 'C';
is $args->[1], 1;
is $args->[2], 2;
is $args->[10], 10;

is ref($args->[11]), 'CODE';
is $args->[11]->(), 40;

# $m as a method

$args = C->$m(1){ 30 };
is scalar(@$args), 3;
is $args->[0], 'C';
is $args->[1], 1;
is ref($args->[2]), 'CODE';
is $args->[2]->(), 30;

$args = C->$m(1 .. 10){ 40 };
is scalar(@$args), 12;
is $args->[0], 'C';
is $args->[1], 1;
is $args->[2], 2;
is $args->[10], 10;

is ref($args->[11]), 'CODE';
is $args->[11]->(), 40;

# INVOCANT->METHOD BLOCK

$args = C->method { 42 };

is scalar(@$args), 2;
is $args->[0], 'C';
is ref($args->[1]), 'CODE';
is $args->[1]->(), 42;

{   # make closure
    my $x = 10;
    $args = C->method { $x };
}
is scalar(@$args), 2;
is $args->[0], 'C';
is ref($args->[1]), 'CODE';
is $args->[1]->(), 10;

$args = C->method(){ 20 };
is scalar(@$args), 2;
is $args->[0], 'C';
is ref($args->[1]), 'CODE';
is $args->[1]->(), 20;

# XXX: we cannot use a scalar variable as a method
#      it is parsed as INVOCANT->$HASH{ NAME }


done_testing;

mwb.pl

#!perl -w
use strict;
{
    package MyList;
    use Mouse;

    has list => (
        is         => 'ro',
        isa        => 'ArrayRef',
        auto_deref => 1,
        required   => 1,
    );

    sub BUILDARGS{
        my $self = shift;
        return { list => [@_] };
    }

    sub grep{
        my($self, $block) = @_;

        return ref($self)->new(
            grep { $block->($_) } $self->list,
        );
    }

    sub each{
        my($self, $block) = @_;
        foreach (@{$self->list}){
            $block->($_);
        }
        return $self;
    }
}

my $l = MyList->new(qw(foo bar baz));


#XXX: ->each{say} is parsed as ->each{'say'}. why?
$l->grep{ /^b/ }->each{ say @_ };