File Coverage

blib/lib/Hash/StoredIterator.pm

Criterion	Covered	Total	%
statement	86	88	97.7
branch	13	16	81.2
condition			n/a
subroutine	13	14	92.8
pod	6	6	100.0
total	118	124	95.1

package Hash::StoredIterator;

use 5.010000;
use strict;
use warnings;

use base 'Exporter';
use Carp qw/croak carp/;
use B;

our @EXPORT_OK = qw{
    hmap
    eich
    eech
    iterator
    hash_get_iterator
    hash_set_iterator
    hash_init_iterator
    hkeys
    hvalues
};

our $VERSION = '0.007';

require XSLoader;
XSLoader::load( 'Hash::StoredIterator', $VERSION );

sub eich(\%\$) {
    carp "eich is deprecated, you should use iterator() instead";
    my ( $hash, $i_ref ) = @_;

    my $old_it = hash_get_iterator($hash);

    my ( $key, $val );

    my $success = eval {
        if ( !defined $$i_ref )
        {
            hash_init_iterator($hash);
        }
        else {
            hash_set_iterator( $hash, $$i_ref );
        }

        ( $key, $val ) = each(%$hash);

        $$i_ref = hash_get_iterator($hash);

        1;
    };

    hash_set_iterator( $hash, $old_it );
    die $@ unless $success;

    unless ( defined $key ) {
        $$i_ref = undef;
        return;
    }

    return ( $key, $val );
}

sub iterator(\%) {
    my ($hash) = @_;
    my $i = undef;

    return sub {
        my $old_it = hash_get_iterator($hash);

        my ( $key, $val );

        my $success = eval {
            if ( !defined $i ) {
                hash_init_iterator( $hash );
            }
            else {
                hash_set_iterator( $hash, $i );
            }

            ( $key, $val ) = each( %$hash );

            $i = hash_get_iterator($hash);

            1;
        };

        hash_set_iterator( $hash, $old_it );
        die $@ unless $success;

        unless ( defined $key ) {
            $i = undef;
            return;
        }

        return ( $key, $val );
    };
}

sub hmap(&\%) {
    my ( $code, $hash ) = @_;

    my $old_it = hash_get_iterator($hash);
    hash_init_iterator($hash);

    my $success = eval {
        my $iter = iterator %$hash;

        while ( my ( $k, $v ) = $iter->() ) {
            local $_ = $k;
            # Can't use caller(), subref might be from a different package than
            # eech is called from.
            my $callback_package = B::svref_2object($code)->GV->STASH->NAME;
            no strict 'refs';
            local ${"$callback_package\::a"} = $k;
            local ${"$callback_package\::b"} = $v;
            $code->( $k, $v );
        }

        1;
    };

    hash_set_iterator( $hash, $old_it );
    die $@ unless $success;
    return;
}

sub eech(&\%) {
    carp "eech is deprecated, use hmap instead";
    goto &hmap;
}

sub hkeys(\%) {
    my ($hash) = @_;
    croak "ARGH!" unless $hash;

    my $old_it = hash_get_iterator($hash);
    hash_init_iterator($hash);

    my @out = keys %$hash;

    hash_set_iterator( $hash, $old_it );

    return @out;
}

sub hvalues(\%) {
    my ($hash) = @_;

    my $old_it = hash_get_iterator($hash);
    hash_init_iterator($hash);

    my @out = values %$hash;

    hash_set_iterator( $hash, $old_it );

    return @out;
}

1;

__END__