view release on metacpan or  search on metacpan

lib/Sub/Go.pm  view on Meta::CPAN

        while ( my ( $k, $v ) = each %$arg ) {
            local $_ = [$k,$v];
            ( *$caller_a, *$caller_b ) = \( $k, $v );
            push @$ret, $code->( $k, $v );
        }
    }
    elsif ( ref $arg eq 'GLOB' ) {
        while ( <$arg> ) {
            my $r = $code->( $_ );
            last if ref $r eq 'Sub::Go::Break';
            push @$ret, $r;
        }
    }
    elsif ( ref $arg eq 'CODE' ) {
        for ( $arg->() ) {
            my $r = $code->( $_ );
            last if ref $r eq 'Sub::Go::Break';
            push @$ret, $r;
        }
    }
    elsif ( blessed $arg && $arg->can('next') ) {
        while( local $_ = $arg->next ) {
            push @$ret, $code->( $_ );
        }
    } else {
        push @$ret, $code->( $arg ) for $arg;
    }

    # chaining return value processing
    if (   ref $_go_self->{rest} eq __PACKAGE__
        && !$_go_self->{yielded}
        && !$_go_self->{stop} )
    {
        if ( @$ret > 1 ) {
            $_go_self->{by}
                ? $_go_self->{rest}->{code}->( @$ret )
                : $ret ~~ $_go_self->{rest};
        }
        else {
            return $_go_self->{ by }
                ? $_go_self->{rest}->{code}->( @$ret )
                : $ret ~~ $_go_self->{rest};
        }
    }
    elsif ( ref $_go_self->{rest} eq 'SCALAR' ) {
       ${ $_go_self->{rest} } = $ret->[0];
    }
    elsif ( ref $_go_self->{rest} eq 'ARRAY' ) {
       @{ $_go_self->{rest} } = @$ret;
    }
    elsif ( ref $_go_self->{rest} eq 'HASH' ) {
       %{ $_go_self->{rest} } = @$ret;
    }
    else {
        return @$ret > 1 ? $ret
            : $ret->[0] // $ret;
    }
}

sub stop {
    require PadWalker;
    my $self_ref;
    for ( 2 .. 3 ) {
        my $h = PadWalker::peek_my( $_ );
        $self_ref = $h->{ '$_go_self' } and last;
    }
    !$self_ref and croak 'Misplaced yield. It can only be used in a go block.';
    my $self = ${ $self_ref };
    $self->{stop} = 1;
    return bless {}, 'Sub::Go::Break';
}

sub skip {
    return bless {}, 'Sub::Go::Break';
}

sub yield {
    require PadWalker;
    my $self_ref;
    for ( 2 .. 3 ) {
        my $h = PadWalker::peek_my( $_ );
        $self_ref = $h->{ '$_go_self' } and last;
    }
    !$self_ref and croak 'Misplaced yield. It can only be used in a go block.';
    my $self = ${ $self_ref };
    $self->{yielded} = 1;
    $self->{rest}->{code}->( @_ );
}

sub go(&;@) {
    my $code = shift;
    my $rest = shift;
    
    return bless { code => $code, rest => $rest }, __PACKAGE__;
}

sub by(&;@) {
    my ( $code, $rest ) = @_;
    return bless { code => $code, rest => $rest, by => 1 }, __PACKAGE__;
}

1;

=pod

=head1 NAME

Sub::Go - DWIM sub blocks for smart matching 

=head1 VERSION

version 0.01

=head1 SYNOPSIS

    use Sub::Go;

    [ 1, 2, 3 ] ~~ go { say $_  };
    # 1
    # 2
    # 3

    # hashes with $a and $b

    %h ~~ go { say "key $a, value $b" };

    undef ~~ go {
        # never gets called...
    };

    '' ~~ go {
        # ...but this does
    };

    # in-place modify

    my @rs = ( { name=>'jack', age=>20 }, { name=>'joe', age=>45 } );
    @rs ~~ go { $_->{name} = 'sue' };

    # filehandles 

lib/Sub/Go.pm  view on Meta::CPAN

    my $arr = [10..19] go { shift }; # @arr == 1, $arr[0] == 10

Just use C<map> in this case, which is syntactically more sound anyway.

So, there's an alternative implementation for returning values, by 
chaining a reference to a variable, as such:

    my @squares;
    @input ~~ go { $_ ** 2 } \@squares;
    
    my %hash = ( uno=>11, due=>22 );
    my %out;
    %hash ~~ go { "xxx$_[0]" => $_[1] } \%out;
    # %out = ( xxxuno => 11, xxxdue => 22 )

Now you have a C<map> like interface the other way around.

=head2 next iterators 

If you send the block an object which implements 
a method called C<next>, the method will be automatically called
and the return value fed to the block.

    # DBIx::Class resultset
    
    $resultset->search({ age=>100 }) ~~ go {
        $_->name . " is centenary!";
    };

=head1 IMPORTS

=head3 go CODE

The main function here. Don't forget the semicolon at the end of the block.

=head3 yield VALUE

Iterate over into the next block in the chain.
    
    [qw/sue mike/] ~~ go { yield "world, $_" } go { say "hello " . shift };

=head3 skip 

Tell the iterator to stop executing the current block and go
to the next, if any.
    
    return skip;

=head3 stop 

Tell the iterator to stop executing all blocks.

    return stop;

=head1 BUGS

This is pre-alfa, out in the CPAN for a test-drive. There 
are still inconsistencies in the syntax that need some 
more thought, so expect things to change badly. 

L<PadWalker>, a dependency, may segfault in perl 5.14.1.

=head1 SEE ALSO

L<autobox::Core> - has an C<each> method that can be chained together

L<List::Gen>

L<Sub::Chain>

=cut