File Coverage

blib/lib/Iterator/Simple/Util.pm

Criterion	Covered	Total	%
statement	165	168	98.2
branch	57	60	95.0
condition	4	6	66.6
subroutine	44	44	100.0
pod	21	21	100.0
total	291	299	97.3

package Iterator::Simple::Util;
{
  $Iterator::Simple::Util::VERSION = '0.002';
}

# ABSTRACT: Port of List::Util and List::MoreUtils to Iterator::Simple

use strict;
use warnings FATAL => 'all';

use Sub::Exporter -setup => {
    exports => [ qw( igroup ireduce isum
                     imax imin imaxstr iminstr imax_by imin_by imaxstr_by iminstr_by
                     iany inone inotall
                     ifirstval ilastval
                     ibefore ibefore_incl iafter iafter_incl
                     inatatime
               )
             ]
};

use Const::Fast;
use Iterator::Simple qw( iter iterator ichain );

const my $TRUE  => !0;
const my $FALSE => !1;

sub _ensure_coderef {
    unless( ref( shift ) eq 'CODE' ) {
        require Carp;
        Carp::croak("Not a subroutine reference");
    }
}

sub _wrap_code {
    my $code = shift;

    return sub {
        $_ = shift;
        $code->();
    };
}


sub igroup (&$) {
    my ( $is_same_group, $base_iter ) = @_;

    _ensure_coderef( $is_same_group );

    $base_iter = iter $base_iter;

    my $next_record = $base_iter->next;

    # Localize caller's $a and $b
    my ( $caller_a, $caller_b ) = do {
        require B;
        my $caller = B::svref_2object( $is_same_group )->STASH->NAME;
        no strict 'refs';
        map  \*{$caller.'::'.$_}, qw( a b );
    };
    local ( *$caller_a, *$caller_b );

    return iterator {
        defined( my $base_record = $next_record )
            or return;

        return iterator {
            return unless defined $next_record;
            ( *$caller_a, *$caller_b ) = \( $base_record, $next_record );
            return unless $is_same_group->();
            my $res = $next_record;
            $next_record = $base_iter->next;
            return $res;
        };
    };
}


sub ireduce (&$;$) {

    my ( $code, $init_val, $iter );

    if ( @_ == 2 ) {
        ( $code, $iter ) = @_;
    }
    else {
        ( $code, $init_val, $iter ) = @_;
    }

    _ensure_coderef( $code );
    $iter = iter $iter;

    # Localize caller's $a and $b
    my ( $caller_a, $caller_b ) = do {
        require B;
        my $caller = B::svref_2object( $code )->STASH->NAME;
        no strict 'refs';
        map  \*{$caller.'::'.$_}, qw( a b );
    };
    local ( *$caller_a, *$caller_b ) = \my ( $x, $y );

    $x = @_ == 3 ? $init_val : $iter->next;

    defined( $x )
        or return;

    defined( $y = $iter->next )
        or return $x;

    while( defined $x and defined $y ) {
        $x = $code->();
        $y = $iter->next;
    }

    return $x;
}


sub isum ($;$) {
    my ( $init_val, $iter );

    if ( @_ == 1 ) {
        $init_val = 0;
        $iter = $_[0];
    }
    else {
        ( $init_val, $iter ) = @_;
    }

    ireduce { $a + $b } $init_val, $iter;
}


sub imax ($) {
    ireduce { $a > $b ? $a : $b } shift;
}


sub imin ($) {
    ireduce { $a < $b ? $a : $b } shift;
}


sub imax_by (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $code = _wrap_code( $code );

    ireduce { $code->($a) > $code->($b) ? $a : $b } $iter;
}


sub imin_by (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $code = _wrap_code( $code );

    ireduce { $code->($a) < $code->($b) ? $a : $b } $iter;
}


sub imaxstr ($) {
    ireduce { $a gt $b ? $a : $b } shift;
}


sub iminstr ($) {
    ireduce { $a lt $b ? $a : $b } shift;
}


sub imaxstr_by (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $code = _wrap_code( $code );

    ireduce { $code->($a) gt $code->($b) ? $a : $b } $iter;
}


sub iminstr_by (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $code = _wrap_code( $code );

    ireduce { $code->($a) lt $code->($b) ? $a : $b } $iter;
}


sub iany (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    while( defined( $_ = $iter->next ) ) {
        $code->() and return $TRUE;
    }

    return $FALSE;
}


sub inone (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    while( defined( $_ = $iter->next ) ) {
        $code->() and return $FALSE;
    }

    return $TRUE;
}


sub inotall (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    while( defined( $_ = $iter->next ) ) {
        return $TRUE if ! $code->();
    }

    return $FALSE;
}


sub ifirstval (&$) {
    my ( $code, $iter ) = @_;
    _ensure_coderef( $code );
    $iter = iter $iter;

    while( defined( $_ = $iter->next ) ) {
        $code->() and return $_;
    }

    return;
}


sub ilastval (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    my $val;
    while( defined( $_ = $iter->next ) ) {
        $val = $_ if $code->();
    }

    return $val;
}


sub ibefore (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    return iterator {
        defined( $_ = $iter->next )
            or return;
        $code->()
            and return;
        return $_;
    };
}


sub ibefore_incl (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    my $done = $FALSE;

    return iterator {
        not( $done ) and defined( $_ = $iter->next )
            or return;
        $code->() and $done = $TRUE;
        return $_;
    };
}


sub iafter (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    while( defined( $_ = $iter->next ) ) {
        last if $code->();
    }

    return $iter;
}


sub iafter_incl (&$) {
    my ( $code, $iter ) = @_;

    _ensure_coderef( $code );
    $iter = iter $iter;

    while( defined( $_ = $iter->next ) ) {
        last if $code->();
    }

    return ichain iter( [$_] ), $iter;
}


sub inatatime ($$) {
    my ($kicks, $iter) = @_;

    $iter = iter $iter;

    return iterator {
        my @vals;

        for (1 .. $kicks) {
            my $val = $iter->next;
            last unless defined $val;
            push @vals, $val;
        }
        return @vals ? \@vals : undef;
    };
}


1;



=pod

=head1 NAME

Iterator::Simple::Util - Port of List::Util and List::MoreUtils to Iterator::Simple

=head1 VERSION

version 0.002

=head1 SYNOPSIS

    use Iterator::Simple::Util qw(  igroup ireduce isum
                                    imax imin imaxstr iminstr imax_by imin_by imaxstr_by iminstr_by
                                    iany inone inotall
                                    ifirstval ilastval
                                    ibefore ibefore_incl iafter iafter_incl
                                    inatatime );

=head1 DESCRIPTION

B implements many of the functions from
L and L for iterators generated by
L.

=head1 EXPORTS

All of these functions call C on the
I> argument; this detects what I> is and turns it
into an iterator. See L for details.

Functions taking a I expect a code block that operates on
C<$_> or, in the case of B and B, on C<$a> and C<$b>.

=over 4

=item igroup I I

=item ireduce I [I] I

Reduces I by calling I, in a scalar context, multiple times,
setting C<$a> and C<$b> each time. The first call will be with C<$a>
and C<$b> set to the first two elements of the list, subsequent
calls will be done by setting C<$a> to the result of the previous
call and C<$b> to the next element in the list.

Returns the result of the last call to I. If the iterator is
empty then C is returned. If the iterator only contains one
element then that element is returned and I is not executed.

    $foo = ireduce { $a < $b ? $a : $b } $iterator  # min
    $foo = ireduce { $a lt $b ? $a : $b } $iterator # minstr
    $foo = ireduce { $a + $b } $iterator            # sum
    $foo = ireduce { $a . $b } $iterator            # concat

If your algorithm requires that C produce an identity value, then
make sure that you always pass that identity value as the first argument to prevent
C being returned. For example:

    $foo = ireduce { $a + $b } 0, $iterator

will return 0 (rather than C) when C<$iterator> is empty.

=item isum [I] I

Returns the sum of the elements of I, which should return
numeric values. Returns 0 if the iterator is empty.

=item imax I

Returns the maximum value of I, which should produce numeric
values. Retruns C if the iterator is empty.

=item imin I

Returns the minimum value of I, which should produce numeric
values. Returns C if the iterator is empty.

=item imax_by I I

Return the value of I for which I produces the maximum value.
For example:

   imax_by { $_ * $_ } iter( [ -5 -2 -1 0 1 2 ] )

will return C<-5>.

=item imin_by I I

Similar to B, but returns the value of I for which
I produces the minimum value.

=item imaxstr I

Similar to B, but expects I to return string values.

=item iminstr I

Similar to B, but expects I to return string values.

=item imaxstr_by I I

Similar to B, but expects I to return string values.

=item iminstr_by I I

Similar to B, but expects I to return string values.

=item iany I I

Returns a true value if any item produced by I meets the
criterion given through I. Sets C<$_> for each item in turn:

    print "At least one value greater than 10"
        if iany { $_ > 10 } $iterator;

Returns false otherwise, or if the iterator is empty.

=item inone I I

Returns a true value if no item produced by I meets the
criterion given through I, or if the iterator is empty. Sets
C<$_> for each item in turn:

    print "No values greater than 10"
        if inone { $_ > 10 } $iterator;

Returns false otherwise.

=item inotall I I

Logically the negation of I. Returns true if I returns
false for some value of I:

   print "Not all even"
     if inotall { $_ % 2 == 0 } $iterator;

Returns false if the iterator is empty, or all values of I
produces a true value for every item produced by I.

=item ifirstval I I

Returns the first element produced by I for which I
evaluates to true. Each element produced by I is set to
C<$_> in turn. Returns C if no such element has been found.

=item ilastval I I

Returns the last element produced by I for which I
evaluates to true. Each element of I is set to C<$_> in
turn. Returns C if no such element has been found.

=item ibefore I I

Returns an iterator that will produce all values of I upto
(and not including) the point where I returns a true
value. Sets C<$_> for each element in turn.

=item ibefore_incl I I

Returns an iterator that will produce all values of I upto
(and including) the point where I returns a true value. Sets
C<$_> for each element in turn.

=item iafter I I

Returns an iterator that will produce all values of I after
(and not including) the point where I returns a true
value. Sets C<$_> for each element in turn.

    $it = iafter { $_ % 5 == 0 } [1..9];    # $it returns 6, 7, 8, 9

=item iafter_incl I I

Returns an iterator that will produce all values of I after
(and including) the point where I returns a true value. Sets
C<$_> for each element in turn.

    $it = iafter_incl { $_ % 5 == 0 } [1..9];    # $it returns 5, 6, 7, 8, 9

=item inatatime I I

Creates an array iterator that returns array refs of elements from
I, I items at a time. For example:

    my $it = inatatime 3, iter( [ 'a' .. 'g' ] );
    while( my $vals = $it->next ) {
        print join( ' ', @{$vals} ) . "\n";
    }

This prints:

    a b c
    d e f
    g

=back

=head1 AUTHOR

Ray Miller

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Ray Miller.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__