File Coverage

blib/lib/Data/Iter.pm

Criterion	Covered	Total	%
statement	12	93	12.9
branch	0	24	0.0
condition	0	8	0.0
subroutine	4	32	12.5
pod	14	21	66.6
total	30	178	16.8

package Data::Iter;

use 5.006;
use strict;
use warnings;

use Carp;


$Carp::Verbose = 1;


require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(iter counter COUNTER LAST_COUNTER value VALUE key KEY get GET getnext GETNEXT GETPREV IS_LAST IS_FIRST transform_array_to_hash) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '0.2';

# Preloaded methods go here.

#prototype of ($$) is important for sort functions

sub sort_alpha($$) { $_[0] cmp $_[1] }
sub sort_num($$) { $_[0] <=> $_[1] }

our $cref_sort = sub { $a cmp $b };

sub default_sort { $cref_sort->(@_) }

our $Sort = 'default_sort';

our $options = { };

sub _KEY       { 0 }
sub _VALUE     { 1 }
sub _COUNT     { 2 }
sub _KEY_REF   { 3 }
sub _VALUE_REF { 5 }
sub _LIST_REF  { 6 }

sub iter
{
	my $this = shift if ( ref $_[0] || $_[0] ) eq __PACKAGE__;

	my $cnt = 0;

	my $ref_data = shift;

	my @result = ();

	unless( @_ )
	{
		if( ref $ref_data eq 'HASH'  )
		{
			foreach my $key ( sort $Sort keys %{ $ref_data } )
			{
				my $obj = [];

				@$obj[ _KEY, _VALUE, _COUNT, _KEY_REF, _VALUE_REF, _LIST_REF ] = ( $key, $ref_data->{$key}, $cnt, \$key, \( $ref_data->{$key}, \@result ) );

				push @result, bless $obj, __PACKAGE__;

				$cnt++;
			}
		}
		elsif( ref $ref_data eq 'ARRAY' )
		{
			@result = ();

			foreach my $value ( @$ref_data )
			{
				my $obj = [];

				@$obj[ _KEY, _VALUE, _COUNT, _VALUE_REF, _LIST_REF ] = ( $cnt, $value, $cnt, \( $ref_data->[$cnt] ), \@result );

				push @result, bless $obj, __PACKAGE__;

				$cnt++;
			}
		}
		else
		{
			croak "iter() only accepts reference to ARRAY or HASH. Found: ". ref( $ref_data );
		}
	}
	else
	{
		croak "iter() only accepts one parameter (reference to ARRAY or HASH). Found extra args: ", scalar @_;
	}

return @result;
}

sub _handle_this
{
	my $this;

	  # called as method ?

	$this = shift @{$_[0]} if ( ref $_[0]->[0] || defined $_[0]->[0] ) eq __PACKAGE__;

	  # no, so use $_ as obj

	$this = $_ unless $this;

return $this;
}



sub counter
{
	my $this = _handle_this( \@_ );

return $this->[_COUNT];
}

sub COUNTER { goto &counter }

sub value
{
	my $this = _handle_this( \@_ );

		# set value if argument given

	$this->[_VALUE] = ${ $this->[_VALUE_REF] } = $_[0] if @_;

return $this->[_VALUE];
}

sub VALUE { goto &value }

sub key
{
	my $this = _handle_this( \@_ );

		# set value if argument given

	$this->[_VALUE] = ${ $this->[_KEY_REF] } = $_[0] if @_;

return $this->[_KEY];
}

sub KEY { goto &key }

sub get
{
	my $this = _handle_this( \@_ );

	my $pos = shift || -1;

return $this->[_LIST_REF]->[$pos];
}

sub GET { goto &get }

sub getnext
{
	my $this = _handle_this( \@_ );

	my $pos = -1;

	my $result = $this->get( $this->counter+1 );

	return $result unless $result;

return $result;
}

sub GETNEXT { goto &getnext }

sub GETPREV
{
	my $this = _handle_this( \@_ );

return $this->getnext( $this->counter-1 );
}

sub LAST_COUNTER
{
	my $this = _handle_this( \@_ );

return scalar @{ $this->[_LIST_REF] } - 1;
}

sub IS_LAST
{
    my $this = _handle_this( \@_ );

    return $this->COUNTER == $this->LAST_COUNTER;
}

sub IS_FIRST
{
    my $this = _handle_this( \@_ );

    return $this->COUNTER == 0;
}



sub pair
{
	my $this = _handle_this( \@_ );


	if( $this->COUNTER() % 2 == 0 )
	{
	    return ( $this->VALUE, $this->GETNEXT->VALUE );
	}

return ();
}

sub PAIR { goto &pair }

# some nice service functions

    sub transform_array_to_hash
      {
	my $array = shift;


	my $result;

	foreach ( iter $array )
	  {
	    if( COUNTER() % 2 == 0 )
	      {
		#printfln q{%s => %s}, VALUE, GETNEXT->VALUE;

		if( exists $result->{ VALUE() } )
		  {
		    push @{ $result->{ VALUE() } }, GETNEXT->VALUE;
		  }
		else
		  {
		    $result->{ VALUE() } = [ GETNEXT->VALUE ];
		  }
	      }
	  }

	return $result;
      }

1;
__END__