view release on metacpan or  search on metacpan

Iterator.pm  view on Meta::CPAN

	package Data::Iterator;
	require 5.000;

	use strict;
	use Carp;
	use FileHandle;
	use vars qw($VERSION);

	$VERSION = 0.021;

	local $[ 	= 0;

	my %_cfg		= ('_set_'		=>  {'-Nodes'		=> 0,		# show nodes as normal items
										 '-DigLevel'	=> undef,	# dig down to this level
					   					 '-DigFiles'	=> 1,		# show file's content if value is in '-FILE:...'-format
					   					 '-DigGlobs'	=> 1,		# resolve glob references
					   					 '-DigSRefs'	=> 1,		# resolve scalar references
					   					 '-DigCode'		=> 1,		# execute coderefs, capture output
					   					 '-Files'		=> 1,		# allow for '-File:...' root objects
					   					 '-Code'		=> 1,		# allow for coderef root objects
					   					 '-SRefs'		=> 1		# resolve scalarref root objects
										},
					   '_known_refs_'=> [ {qw(ARRAY 1 CODE 1 GLOB 1 HASH 1 SCALAR 1 REF 0 FileHandle 1 VFILE 1 VCODE 0)},
					   					  {qw(ARRAY 1 CODE 1 GLOB 1 HASH 1 SCALAR 1 REF 0 FileHandle 1 VFILE 1 VCODE 0)} ],
					   '_init_'		=> sub {my $me = shift;
					   						@{$me->{'_known_refs_'}[0]}{'VFILE', 'GLOB', 'CODE', 'SCALAR'} = @{$me->{'_set_'}}{'-Files', '-Globs', '-Code', '-SRefs'};
					   						@{$me->{'_known_refs_'}[1]}{'VFILE', 'GLOB', 'CODE', 'SCALAR'} = @{$me->{'_set_'}}{'-DigFiles', '-DigGlobs', '-DigCode', '-DigSRefs'};
					   					   }
					  );
	my %br			= ('HR'	=> [('{\'', '\'}')],
					   'AR'	=> [('[', ']')],
					   'SR'	=> [('','')],
					   'GR' => [('[',']')],
					   'FH'	=> [('[',']')],
					   'SV'	=> [('','')],
					   'VF'	=> [('<','>')],
					   '0'	=> [('','')]);
	my %init =	('ARRAY'	=> sub {return $_[0], scalar @{$_[0]}, -1, 'ARRAY', @{$br{'AR'}}, $_[0];},
				 'CODE'		=> sub {my (@e, @r);
				 					eval {local $SIG{__DIE__}	= sub { chomp @_;push @e, 'FATAL: '.join ('', @_);
																		if (scalar (caller(0)) eq 'Carp') {
																			my $loc = sprintf (" at %s line %s", (caller(1))[1,2]);
																			$e[-1] =~ s/( at .*?)$/$loc/;
																		}
																	  	die};
		 								  local $SIG{__WARN__}	= sub {chomp @_;push @e, 'WARN : '.join ('', @_);
																		if (scalar (caller(0)) eq 'Carp') {
																			my $loc = sprintf (" at %s line %s", (caller(1))[1,2]);
																			$e[-1] =~ s/( at .*?)$/$loc/;
																		}
																	   };
										  @r = $_[0]->();
										 };
									unshift @r, {('_ERR_' => \@e)};
					 				return \@r, scalar @r, -1, 'ARRAY', @{$br{'AR'}}, $_[0];
								   },
				 'GLOB'		=> sub {return $_[0], undef, -1, 'GLOB', @{$br{'GR'}}, $_[0];},
				 'HASH'		=> sub {my @k = keys %{$_[0]};
				 					return $_[0], \@k, scalar @k, -1, 'HASH', @{$br{'HR'}}, $_[0];},
				 'SCALAR'	=> sub {return $_[0], 1, -1, 'SCALAR', @{$br{'SR'}}, $_[0];},
				 'VFILE'	=> sub {my ($file) = $_[0] =~ /^-FILE:(.+)/;
									my $fh = new FileHandle ("< $file");
									carp ("Iterator::init failed on opening file:\n\t'$file': $!") && return undef unless $fh;
									return $fh, undef, -1, 'FileHandle', @{$br{'FH'}}, $_[0];
									},
				 'VCODE'	=> sub {},
				 'undef'	=> sub {return \$_[0], 1, -1, 'undef', @{$br{'SV'}}, \$_[0];},
				);
	my %elem = 	('ARRAY'	=> sub {return  (++$_[0]->[2] < $_[0]->[1]				 ?
				 								($_[0]->[2], \$_[0]->[0][$_[0]->[2]]):
				 								())