File Coverage

blib/lib/NoSQL/PL2SQL/Perldata.pm

Criterion	Covered	Total	%
statement	9	67	13.4
branch	0	42	0.0
condition	0	15	0.0
subroutine	3	8	37.5
pod	0	5	0.0
total	12	137	8.7

package NoSQL::PL2SQL::Perldata ;

use 5.008009;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use NoSQL::PL2SQL::Perldata ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw() ] ) ;

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

our @EXPORT = qw() ;

our $VERSION = '0.03';


# Preloaded methods go here.

sub refto {
	my $self = shift ;
	my $key = shift ;
	my $o = $self->{$key} ;

	my $refto = $o->{refto} ;
	return $refto? refto( $self, $refto ) || $refto: '' ;
	}

sub lastitem {
	my $self = shift ;
	my $key = shift ;
	my $o = $self->{$key} ;
	return [ refto => $key ] unless $o->{refto} ;

	my $ii = $key ;
	for ( my $i = $o->{refto} ; $i ; $i = $self->{ $i }->{item} ) {
		$ii = $i ;
		}

	return [ item => $ii ] ;
	}

sub descendants {
	my $self = shift ;
	my $key = shift ;
	my $o = $self->{$key} ;

	my $nosiblings = shift ;
	my @out = () ;

	push @out, descendants( $self, $o->{item} )
			if $o->{item} && ! $nosiblings ;
	push @out, descendants( $self, $o->{refto} )
			if $o->{refto} && $o->{reftype} ne 'scalarref' ;
	return ( @out, $key ) ;
	}

sub fetchextract {
	my $sqlobject = shift ;
	my $self = $sqlobject->{perldata} ;
	my $key = shift ;
	my @nvpflag = @_ ;
	my $o = $self->{$key} ;
	my @out = () ;
	my $out ;

	@out = fetchextract( $sqlobject, $o->{item}, @nvpflag )
			if $o->{item} ;
	my @inner = () ;

	return @out if $o->{deleted} ;
	my $item = item( $self, $o ) ;

	if ( grep $item->[0] eq $_, qw( item scalar ) ) {
		$out = bless { data => $item->[1],
				top => $key,
				reftype => 'item' }, $sqlobject->package ;
		map { $out->{$_} = $sqlobject->{$_} }
				@NoSQL::PL2SQL::members ;
		return @out, ( @nvpflag? $o->{ $nvpflag[0] }: () ), $out ;
		}
	elsif ( $item->[0] eq 'hashref' ) {
		tie my( %out ), $sqlobject, $key ;
		$out = \%out ;
		}
	elsif ( $item->[0] eq 'arrayref' ) {
		tie my( @out ), $sqlobject, $key ;
		$out = \@out ;
		}
	elsif ( $item->[0] eq 'scalarref' ) {
		tie my( $refout ), $sqlobject, $key, $item->[1] ;
		$out = \$refout ;
		}
	else {
		## Never supposed to hit this
		warn "Unknown: " .$key ;
		}

	bless $out, $o->{blesstype} if $o->{blesstype} ;
	return @out, ( @nvpflag? $o->{ $nvpflag[0] }: () ), $out ;
	}

sub item {
	my $self = shift ;
	my $o = shift ;

	$o = $self->{$o} unless ref $o ;

	return [ item => undef ] unless $o->{defined} ;

	return [ $o->{reftype}, undef ] unless
			grep $_ eq $o->{reftype},
			  qw( item scalar scalarref string ) ;

	my $rv = [ $o->{reftype} ] ;
	$rv->[1] = $o->{intdata} *1 if defined $o->{intdata} ;
	$rv->[1] = $o->{floatdata} *1.0 if defined $o->{floatdata} ;
	$rv->[1] = $o->{stringdata} if defined $o->{stringdata} ;
	warn $rv->[1] = $o->{stringrepr} if @$rv == 1 && ! $o->{refto} ;

	$rv->[1] .= item( $self, $o->{chainedstring} )->[1]
			if defined $o->{stringdata} && $o->{chainedstring} ;
	return $rv ;
	}

1;
__END__