File Coverage

blib/lib/NoSQL/PL2SQL/Object.pm

Criterion	Covered	Total	%
statement	27	507	5.3
branch	0	282	0.0
condition	0	107	0.0
subroutine	9	62	14.5
pod	2	27	7.4
total	38	985	3.8

package NoSQL::PL2SQL::Clone ;
our @ISA = qw( NoSQL::PL2SQL::Object ) ;
use strict;
use warnings;

sub update {
	my $self = shift ;
	my $data = $self->{globals}->{memory}->{ $self->objectkey }->[0] ;

	if ( $self->{reftype} eq 'hashref' ) {
		my %out = map { $_ => NoSQL::PL2SQL::Object::item(
				$data->{$_} )->[1] || $data->{$_} }
				keys %$data ;
		$self->{data} = \%out ;
		}
	elsif ( $self->{reftype} eq 'arrayref' ) {
		my @out = map { NoSQL::PL2SQL::Object::item( $_ ) || $_ }
				@$data ;
		$self->{data} = \@out ;
		}
	elsif ( $self->{reftype} eq 'scalarref' ) {
		$self->{data} = \$data ;
		}
	else {
		$self->{data} = $data ;
		}
	}

sub sqlclone {
	my $self = shift ;
	my $data = $self->{data} ;
	my $out ;

	if ( $self->{reftype} eq 'hashref' ) {
		my %o = map { $_ => innerclone( $data->{ $_ } ) }
				keys %$data ;
		$out = $self->mybless( \%o ) ;
		}
	elsif ( $self->{reftype} eq 'arrayref' ) {
		my @o = map { innerclone( $_ ) } @$data ;
		$out = $self->mybless( \@o ) ;
		}
	elsif ( $self->{reftype} eq 'scalarref' ) {
		my $o = $$data ;
		$out = $self->mybless( \$o ) ;
		}
	else {
		$out = $data ;
		}

	for my $v ( values %{ $self->{globals}->{memory} } ) {
		my $item = NoSQL::PL2SQL::Object::item( $v->[0] ) ;
		delete $item->[1]->{clone} if $item && $item->[1] ;
		}

	return $out ;
	}

sub innerclone {
	return NoSQL::PL2SQL::Object::innerclone( @_ ) ;
	}

sub DESTROY {
	my $self = shift ;

	$self->{globals}->{lock} ||= new NoSQL::PL2SQL::Lock $self
			if $self->{data} && ! $self->{globals}->{rollback} ;
	}


package NoSQL::PL2SQL::Lock ;
use strict;
use warnings;

my @errors ;

sub new {
	my $package = shift ;
	my $o = shift ;
	my $dsn = $o->{sqltable} ;
	my $header = $o->{globals}->{header} ;
	my $out = [ $dsn, $header ] ;

  	my $lock = $dsn->new->update( undef => [ deleted => 1 ] )->{nvp} ;
	my $incr = $dsn->new->update( undef =>
			[ intdata => $header->{intdata} +1 ] )->{nvp} ;

	for ( my $ct = 0 ; ! setlock( $dsn, $lock, $header->{id} ) ; $ct++ ) {
		select undef, undef, undef, .200 ;  ## wait 5 seconds
		next if $ct < 50 ;

		## deadlock failure
		@errors = NoSQL::PL2SQL->sqlerror unless @errors ;
		NoSQL::PL2SQL::sqlcarp( $header->{objecttype}, $errors[7],
				{ timestamp => time,
				  recordid => $header->{id} },
				$o->sqlclone,
				sprintf "%s: %d", $errors[7], $o->{top} ) ;

		$o->{globals}->{rollback} = 1 ;
		return $out ;
		}

	my $updates = $dsn->sqlupdate( $incr,
			[ id => $header->{id} ],
			[ intdata => $header->{intdata} ] ) ;

	unless ( $updates *1 ) {
		$o->{globals}->{rollback} = 1 ;
		push @$out, $o->mybless( $o->sqlclone ) ;
		my $serial = $dsn->fetch( [ id => $header->{id} ]
				)->{ $header->{id} }->{intdata} || 0 ;
  		$incr = $dsn->new->update(
				undef => [ intdata => ++$serial ] )->{nvp} ;
		$dsn->sqlupdate( $incr, [ id => $header->{id} ] ) ;
		}

	return bless $out, $package ;
	}

sub setlock {
	my $dsn = shift ;
	my $lock = shift ;
	my $id = shift ;
	my $r = $dsn->sqlupdate( $lock,
			[ id => $id ],
			$dsn->exclude( [ deleted => 1 ] ) ) ;
	return $r *1 ;
	}

sub DESTROY {
	my $self = shift ;
	my $dsn = $self->[0] ;
	my $header = $self->[1] ;

	if ( @$self == 3 ) {
		## delete all records except header
		$dsn->delete( [ objectid => $header->{objectid} ],
				[ objecttype => $header->{objecttype}, 1 ],
				$dsn->exclude( [ id => $header->{id} ] )
				) ;

		## insert clone
		my @nodes = NoSQL::PL2SQL::Node->factory(
				0, $header->{objectid}, $self->[2] ) ;
		pop @nodes ;
		my ( $ll, $refs ) = NoSQL::PL2SQL::Node->insertall(
				$dsn, NoSQL::PL2SQL::Node->combine( @nodes )
				) ;

		## swap out new header
		my $refto = $dsn->new->update( undef, [ refto => $ll ]
				)->{nvp} ;
		$dsn->sqlupdate( $refto, [ id => $header->{id} ] ) ;
		}

	my $unlock = $dsn->new->update( undef => [ deleted => 0 ] )->{nvp} ;
	$dsn->sqlupdate( $unlock, [ id => $header->{id} ] ) ;
	}


package NoSQL::PL2SQL::Object ;

use 5.008009;
use strict;
use warnings;
use Scalar::Util ;

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::Object ':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.08';

# Preloaded methods go here.

sub TIEHASH {
	my $self = shift ;
	my $out = bless { %$self }, $self->package ;
	$out->{top} = shift @_ if @_ ;
	$out->{reftype} = $out->record->{reftype} ;
	return $out ;
	}

sub TIEARRAY {
	my $self = shift ;
	my $out = bless { %$self }, $self->package ;
	$out->{top} = shift @_ if @_ ;
	$out->{reftype} = $out->record->{reftype} ;
	return $out ;
	}

sub TIESCALAR {
	my $self = shift ;
	my $out = bless { %$self }, $self->package ;
	$out->{top} = shift @_ if @_ ;
	$out->{data} = shift ;
	$out->{reftype} = $out->record->{reftype} ;
	return $out ;
	}

## sub destroy {}	## for ctags
## avoid running during global destruction
sub DESTROY {
	my $self = shift ;
	my @xml = () ;

	delete $self->{globals}->{clone} ;

	return if $self->{globals}->{rollback} ;
	return unless $self->{update} ;
	return if $self->{top} && ! $self->record ;	## deleted

	map { $self->{sqltable}->delete( $_ ) } @{ $self->{delete} || [] } ;

	if ( $self->{top} ) {
		@xml = $self->updates ;

		if ( ! exists $xml[-1]{sql}{reftype} ) {}
		elsif ( grep $_ eq $xml[-1]{sql}{reftype},
				qw( scalar scalarref ) ) {
			my @chain = $self->linklist('chainedstring') ;
			map { $_->{sql}->{id} = shift @chain if @chain }
					reverse @xml ;

			map { $self->{sqltable}->delete( $_ ) } @chain ;
			}
		}
	else {
		my $parent = $self->record( $self->{parent } ) ;
		my $r = $parent->{reftype} ;
		my $o = $r eq 'hashref'? { $self->{key} => $self->{data} }:
				$r eq 'arrayref'? [ $self->{data} ]:
				$r eq 'scalarref'? \$self->{data}:
				return warn ;
		@xml = NoSQL::PL2SQL::Node->factory( 0,
				$parent->{objectid}, $o,
				$parent->{objecttype} ) ;
		pop @xml ;	## perldata
		pop @xml unless grep $_ eq $self->{reftype},
				qw( arrayref hashref ) ;

		$xml[-1]{sql}{intkey} = $self->{sequence}
				if exists $self->{sequence} ;
		}

	my @combined = NoSQL::PL2SQL::Node::combine( @xml ) ;

	## references a new element
	foreach my $memo ( grep $_->memory &&
			$self->{globals}->{adds}->{ $_->memory },
			@combined ) {
		my $src = $self->{globals}->{adds}->{ $memo->memory } ;

		map { $memo->{sql}->{$_} = $src->{$_} }
				qw( blesstype reftype refto ) ;
		$memo->{sql}->{refto} = $src->{id}
				if $memo->{sql}->{reftype} eq 'scalarref' ;
		}

	## references an existing element
	if ( my $mrec = $self->refrecord( 1 ) ) {
		splice @combined, 0, -1 ;

		my $src = $self->record( $mrec ) ;
		map { $combined[-1]{sql}{$_} = $src->{$_} }
				qw( blesstype reftype refto ) ;
		$combined[-1]{sql}{refto} = $mrec
				if $combined[-1]{sql}{reftype} eq 'scalarref' ;
		}

	my ( $ll, $refs ) = NoSQL::PL2SQL::Node->insertall(
			$self->{sqltable}, @combined ) ;
	map { $self->{globals}->{adds}->{$_} = $refs->{$_} } keys %$refs ;

	if ( $self->{parent} ) {
	 	my $last = NoSQL::PL2SQL::Perldata::lastitem(
				$self->{perldata}, $self->{parent} ) ;
		$self->{sqltable}->update( $last->[1],
				[ $last->[0] => $ll ] ) ;
		$self->record( $last->[1] )->{ $last->[0] } = $ll ;
		}
	}

sub self {
	my $self = shift ;
	$self->data ;
	return $self->refrecord || $self ;
	}

sub linklist {
	my $self = shift ;
	my $k = pop ;
	my $r = $self->record( @_ ) ;

	my @o = $r->{id} ;
	$o[0] *= -1 if $r->{deleted} && ! $k ;

	my $kk = $k || 'item' ;
	push @o, $self->linklist( $r->{$kk}, $k ) if $r->{$kk} ;
	return @o ;
	}

sub record {
	my $self = shift ;
	my $k = @_? shift( @_ ): $self->{top} ;

	return $self->{perldata}->{ $k } if $k ;

	my @v = values %{ $self->{perldata} } ;
	return { %{ $v[0] } } ;		## clone is not writable
	}

sub topnode {
	my $self = shift ;
	my $top = @_? shift( @_ ): $self->{globals}->{top} ;

	my @ok = grep $_->[1] == $top,
			values %{ $self->{globals}->{memory} } ;
	return $ok[0][0] ;
	}

## The copy creates a second reference to avoid inadvertant destruction
sub load {
	my $self = shift ;
	$self->{data} = shift ;
	$self->{copy} = shift if @_ ;
	$self->{ref} = $self->{data} ;

	return $self->{data} unless ref $self->{data} ;

	my @elements = $self->{reftype} eq 'hashref'?
			  values %{ $self->{data} }:
			$self->{reftype} eq 'arrayref'? @{ $self->{data} }:
			$self->{reftype} eq 'scalarref'? ( ${ $self->{data} } ):
			warn "unknown reftype: " .$self->{reftype} ;

	foreach my $o ( grep ref $_, @elements ) {
		my @oo = @{ item( $o ) } ;
		next unless $oo[1]{top} ;

		my $k = $self->{globals}->{records}->{ $oo[1]{top} } ;
		my $rec = $self->{globals}->{memory}->{$k} if $k ;
		$self->{data} = $rec->[0] if $rec ;

		$self->{globals}->{records}->{ $oo[1]{top} }
				= $self->objectkey ;
		$self->{globals}->{refcount}->{ $oo[1]{top} }++ ;

		my $refto = $oo[1]{reftype} eq 'scalarref'?
				$oo[1]->refto || $oo[1]->{top}: '' ;
		$oo[1]->loadscalarref( $refto )
				if $refto && ! exists
				  $oo[1]->{globals}->{scalarrefs}->{$refto} ;

		next if $oo[1] == $o ;
		$oo[1]->memorymap( $o ) ;
		}

	return $self->{data} ;
	}

## refactoring?  may duplicate Perldata::fetchextract()
sub loadscalarref {
	my $self = shift ;
	my $refto = shift ;

	my $rr = $self->newelement(
			NoSQL::PL2SQL::Perldata::item(
			  $self->{perldata}, $refto )->[1]
			) ;
	map { delete $rr->{$_} }
			qw( parent last update globals ) ;
	$rr->{reftype} = $self->{reftype} ;
	$rr->{top} = $refto ;
	$self->{globals}->{scalarrefs}->{ $refto } = $rr ;
	$self->{globals}->{refcount}->{ $refto }++ ;
	}

sub memorymap {
	my $self = shift ;
	my $target = shift ;
	my $k = $self->objectkey ;
	my $top = @_? shift( @_ ): $self->{top} ;

	$self->{globals}->{memory}->{$k} = [ $target, $top ] ;
	Scalar::Util::weaken( $self->{globals}->{memory}->{$k}->[0] ) ;

	return $target ;
	}

sub data {
	my $self = shift ;
	my @inner = () ;
	my $blesstype = $self->record->{blesstype} ;
	my $refto = $self->record->{refto} ;

	my @args = @_ ;

	if ( $self->{reftype} eq 'hashref' ) {
		unless ( $self->{data} ) {
			@inner = NoSQL::PL2SQL::Perldata::fetchextract(
					$self, $refto, 'textkey' )
					if $refto ;

			$self->load( { @inner }, { @inner } ) ;
			bless $self->{data}, $blesstype if $blesstype ;
			}

		if ( @args ) {
			my $item = item( $self->{data}->{ $args[0] } ) ;
			return @args == 1? $item: $item->[ $args[1] ] ;
			}
		}

	elsif ( $self->{reftype} eq 'arrayref' ) {
		unless ( $self->{data} ) {
			@inner = NoSQL::PL2SQL::Perldata::fetchextract(
					$self, $refto, 'intkey' )
					if $refto ;
			my @sorter = () ;
			push @sorter, [ splice @inner, 0, 2 ] while @inner ;
			my @sorted = map { $_->[1] }
					sort { $a->[0] <=> $b->[0] }
					@sorter ;

			$self->load( \@sorted, [ @sorted ] ) ;
			bless $self->{data}, $blesstype if $blesstype ;
			}

		if ( @args ) {
			my $item = item( $self->{data}->[ $args[0] ] ) ;
			return @args == 1? $item: $item->[ $args[1] ] ;
			}
		}

	elsif ( $self->{reftype} eq 'scalarref' ) {
		my $top = $self->record->{refto} || $self->{top} ;
		return @args == 2? $self->scalarref->[0]:
				@args == 1? $self->scalarref:
				$self->topnode( $top ) ;
		}

	else {
		return $self->{reftype} ;
		}

	return $self->{data} ;
	}

sub refto {
	my $self = shift ;
	return NoSQL::PL2SQL::Perldata::refto(
			$self->{perldata}, $self->{top} ) ;
	}

sub sqlclone {
	my $tied = shift ;
	my $self = item( $tied )->[1] ;
	my $out = innerclone( $tied, $self ) ;

	for my $v ( values %{ $self->{globals}->{memory} } ) {
		my $item = item( $v->[0] ) ;
		delete $item->[1]->{clone} if $item && $item->[1] ;
		}

	delete $self->{clone} ;
	return $out ;
	}

sub innerclone {
	my $tied = shift ;

	my $self = @_? $_[0]: item( $tied )->[1] ;
	return $tied unless defined $self ;

	my $data = $self->data ;
	my $reference = NoSQL::PL2SQL::Object::item( $data )->[1] || 0 ;
	return $reference->{clone} if $reference && $reference->{clone} ;

	if ( $self->{reftype} eq 'hashref' ) {
		my %o = map { $_ => innerclone( $self->data->{ $_ } ) }
				keys %$data ;
		return $self->{clone} = $self->mybless( \%o ) ;
		}
	elsif ( $self->{reftype} eq 'arrayref' ) {
		my @o = map { innerclone( $_ ) } @$data ;
		return $self->{clone} = $self->mybless( \@o ) ;
		}
	elsif ( $self->{reftype} eq 'scalarref' ) {
		my $o = ${ $self->data } ;
		return $self->mybless( \$o ) ;
		}

	return $self->{clone} = $self->{data} ;
	}

sub scalarref {
	my $self = shift ;
	my $data = $self->{globals}->{scalarrefs}->{
			$self->refto || $self->{top} }->{data} ;
	return [ $data, $self ] ;
	}

## what it is as a reference is not what it is as a standalone object

sub item {
	my $self = shift ;

	return [ $self, undef ] unless ref $self ;
	return [ $self, tied %$self ] if ref $self eq 'HASH' && tied %$self ;
	return [ $self, tied @$self ] if ref $self eq 'ARRAY' && tied @$self ;
	return [ $self, tied $$self ] if ref $self eq 'SCALAR' && tied $$self ;

	return [ $self, undef ]
			if grep ref $self eq $_, qw( HASH ARRAY SCALAR ) ;
	return [ $self->{data}, $self ] if ref $self eq __PACKAGE__ ;

	return [ $self, tied %$self ] if $self->isa('HASH') && tied %$self ;
	return [ $self, tied @$self ] if $self->isa('ARRAY') && tied @$self ;
	return [ $self, tied $$self ] if $self->isa('SCALAR') && tied $$self ;

	return [ $self, undef ] ;
	}

sub update {
	my $self = shift ;
	my @sorted = () ;
	push @sorted, [ splice @_, 0, 2 ] while @_ ;
	map { $self->record->{ $_->[0] } = $_->[1] } @sorted ;
	$self->{update} = 1 ;
	$self->{globals}->{clone}->update
			if $self->{globals}->{clone} ;
	return $self ;
	}

sub mybless {
	my $self = shift ;
	my $o = @_? shift( @_ ): $self ;

	my $blesstype = $self->record->{blesstype} ;
	return $o unless ref $o && $blesstype ;
	return $o if grep $_ eq $blesstype, qw( SCALAR ARRAY HASH ) ;
	return bless $o, $blesstype ;
	}

sub resequence {
	my $self = shift ;
	map { $self->data( $_, 1 )->update()->{sequence} = $_ }
			0..$#{ $self->{data} } ;
	return $self->FETCHSIZE ;
	}

sub refcount {
	my $self = shift ;
	my $recid = @_? shift( @_ ): $self->{top} ;

	return --$self->{globals}->{refcount}->{ $recid } > 0?
			(): ( $recid ) ;
	}

sub refrecord {
	my $self = shift ;
	return undef unless ref $self->{data} ;

	my $ii = item( $self->{data} ) ;
	return undef unless ref $ii->[1] eq ref $self ;

	my $k = $ii->[1]->objectkey ;
	my $v = $self->{globals}->{memory}->{$k} ;
	return undef unless $v ;

	return $v->[ $_[0] ] if @_ ;

	my $rv = item( $v->[0] )->[1] ;
	return $rv->refrecord( @_ ) || $rv ;
	}

sub getkids {
	my $o = shift ;
	my @out = () ;
	return () unless ref $o ;

	@out = values %$o if ref $o eq 'HASH' ;
	@out = @$o unless @out || ref $o ne 'ARRAY' ;
	return () if ref $o eq 'SCALAR' ;
	return () if ref $o eq __PACKAGE__ ;

	@out = values %$o unless @out || ! $o->isa('HASH') ;
	@out = @$o unless @out || ! $o->isa('ARRAY') ;
	return grep ref $_, map { item( $_ )->[1] } @out ;
	}

sub setreference {
	my $v = shift ;
	my $o = item( $v )->[1] ;

	if ( ref $o ne __PACKAGE__ ) {}
	elsif ( $o->{reftype} eq 'scalarref' ) {
		$o->{globals}->{refcount}->{ $o->{top} }++ ;
		}
	else {
		map { $o->{globals}->{refcount}->{ $_->{top} }++ }
				getkids( $o->data ) ;
		}

	return $v ;
	}

sub newelement {
	my $clone = shift ;
	my $self = bless {}, $clone->package ;
	map { $self->{$_} = $clone->{$_} } @NoSQL::PL2SQL::members ;

	$self->{parent} = $clone->{top} ;
	$self->{reftype} = 'item' ;
	$self->{data} = setreference( shift @_ ) if @_ ;
	$self->{update} = 1 ;
	$self->{globals}->{clone}->update
			if $self->{globals}->{clone} ;
	return $self ;
	}

sub equals {
	my $self = shift ;
	my @dd = ( $self->{data}, $self->{ref} ) ;
	$dd[1] = '' unless defined $dd[1] ;
	return ref $dd[0]? $dd[0] == $dd[1]: $dd[0] eq $dd[1] ;
	}

sub scalarok {
	my $self = shift ;

	return () unless $self->{top} ;
	return () if grep $self->{reftype} eq $_,
			qw( scalarref arrayref hashref ) ;
	return () if ref $self->{data} ;
	return () if exists $self->{ref} ;
	return () if length $self->{data} > 512 ;

	my $item = NoSQL::PL2SQL::Perldata::item(
			$self->{perldata}, $self->{top} )->[1] ;
	my @types = NoSQL::PL2SQL::Node::typemap( $self->{data}, $item ) ;
	return () unless $types[0] eq $types[1] ;

	## scalars are perfectly identical
	return ( undef ) unless $self->record->{defined} || defined $item ;
	return ( undef ) if $self->record->{defined}
			&& defined $self->{data}
			&& $self->{data} eq $item ;

	## update scalar information
	$types[0] ||= 'stringrepr' ;
	return ( chainedstring => undef,
			stringrepr => $self->{data},
			$types[0] => $self->{data},
			defined => defined $self->{data} ) ;
	}

sub updates {
	my $o = shift ;
	my $r = $o->record ;

	my %nvp = map { $_ => exists $r->{$_}? $r->{$_}: undef }
				qw( id intkey deleted ) ;
	$nvp{intkey} = $o->{sequence} if exists $o->{sequence} ;

	my $self = bless { sql => \%nvp }, 'NoSQL::PL2SQL::Node' ;

	my %globals = map { $_ => $r->{$_} } qw( objectid objecttype ) ;

	if ( ! exists $o->{data} ) {}
	elsif ( $o->record->{deleted} ) {}
	elsif ( my @rewrite = $o->scalarok ) {
		my %rewrite = @rewrite > 1? @rewrite: () ;
		map { $self->{sql}->{$_} = $rewrite{$_} } keys %rewrite ;
		}
	elsif ( $o->equals( $o->{data}, $o->{ref} ) ) {}
		## existing container ##
	else {
		## scalar/container replacement ##
		my @xml = NoSQL::PL2SQL::Node->factory( 0,
				$globals{objectid},
				$o->{data},
				$globals{objecttype} ) ;
		pop @xml ;	## perldata element

		## pl2sql can't distinguish a scalarref
		$xml[-1]{sql}{reftype} = $o->{reftype}
				if $xml[-1]{sql}{reftype} eq 'scalar'
				&& $o->{reftype} eq 'scalarref' ;

		map { $nvp{$_} = undef } qw( intdata doubledata stringdata ) ;
		my $sql = $xml[-1]{sql} ;
		map { $nvp{$_} = $sql->{$_} } keys %$sql ;
		$xml[-1]{sql} = \%nvp ;

		foreach my $xml ( @xml ) {
			map { $xml->{sql}->{$_} = $globals{$_} }
					keys %globals
					unless $xml == $xml[-1] ;
			}

		return @xml ;
		}

	return $self ;
	}

sub objectkey {
	my $self = shift ;
	return overload::StrVal( $self ) ;
	}

sub package {
	return __PACKAGE__ ;
	}

sub FETCH {
	my $self = self( shift @_ ) ;
	my $k = shift ;
	my $item = $self->data( $k ) ;

	return ref( $item->[0] )
			  && $item->[1]->{top}
			  && $item->[1]->{reftype} eq 'scalarref'?
			$item->[1]->data: $item->[0] ;
	}

sub STORE {
	my $self = self( shift @_ ) ;
	my $v = pop ;
	my $k = shift( @_ ) if @_ ;
	my $element ;
	my $o ;

	if ( $self->{reftype} eq 'hashref' ) {
		$o = $self->{data}->{$k} = $self->{data}->{$k}?
				item( $self->{data}->{$k} )->[1]:
				$self->newelement ;
		$o->{key} = $k ;
		}
	elsif ( $self->{reftype} eq 'arrayref' ) {
		my $seqflag = ! $self->{data}->[$k] ;
		$o = $self->{data}->[$k] = $self->{data}->[$k]?
				item( $self->{data}->[$k] )->[1]:
				$self->newelement ;

		map { $self->{data}->[$_] ||= $self->newelement() }
				0..$#{ $self->{data} } ;
		$self->resequence if $seqflag ;
		}
	elsif ( $self->{reftype} eq 'scalarref' ) {
		$o = $self->{globals}->{scalarrefs}->{
				$self->refto || $self->{top} } ;
		$o->{globals}->{header} ||= $self->{globals}->{header} ;
		}
	else {
		warn $self->{reftype} ;
		}

	$o->CLEAR if grep $_ eq $o->{reftype}, qw( hashref arrayref ) ;
	$o->{data} = setreference( $v ) ;
	$o->update( deleted => undef ) ;

	return $o->{data} ;
	}

sub STORESIZE {
	my $self = self( shift @_ ) ;
	my $count = shift ;
	}

sub EXTEND {
	my $self = self( shift @_ ) ;
	$self->STORESIZE( @_ ) ;
	}

sub FETCHSIZE {
	my $self = self( shift @_ ) ;
	return scalar @{ $self->{data} } ;
	}

sub POP {
	my $self = self( shift @_ ) ;
	my $k = $self->FETCHSIZE -1 ;
	return $self->DELETE( $k, 1 ) ;
	}

sub PUSH {
	my $self = self( shift @_ ) ;
	my @add = map { $self->newelement( $_ ) } @_ ;

	push @{ $self->{data} }, @add ;
	return $self->resequence ;
	}

sub SHIFT {
	my $self = self( shift @_ ) ;
	my $k = 0 ;
	my $rv = $self->DELETE( $k, 1 ) ;

	$self->resequence ;
	return $rv ;
	}

sub UNSHIFT {
	my $self = self( shift @_ ) ;

	unshift @{ $self->{data} },
			map { $self->newelement( $_ ) } @_ ;
	return $self->resequence ;
	}

sub SPLICE {
	my $self = self( shift @_ ) ;
	my $offset = @_? shift( @_ ): 0 ;
	my $length = @_? shift( @_ ): $self->FETCHSIZE -$offset ;
	my @add = map { $self->newelement( $_ ) } @_ ;

	my @sample = ( 0..$#{ $self->{data} } ) ;
	my @gone = splice @sample, $offset, $length, map { \$_ }
			0..$#add ;
	my @data = map { ref $_? $add[ $$_ ]: $self->{data}->[$_] }
			@sample ;

	my @rv = map { $self->FETCH( $_ ) } @gone ;
	map { $self->DELETE( $_, 1 ) } reverse @gone ;

	$self->{data} = \@data ;
	$self->resequence ;
	return @rv ;
	}

sub DELETE {
	my $rv = FETCH( @_ ) ;
	my $self = self( shift @_ ) ;
	my $k = shift ;
	my $obliterate = shift ;

	$self->sqlclone ;	## need to expose all references

	my $item = $self->data( $k ) ;
	my $o = $item->[1] ;
	return undef unless $o ;

	$o->CLEAR unless $o->{reftype} eq 'item' ;
	$o->update( deleted => 1 ) if $obliterate ;

	if ( $self->{reftype} eq 'hashref' ) {
		$o->update( deleted => 1 ) ;
		delete $self->{data}->{$k} ;
		}
	elsif ( $self->{reftype} eq 'arrayref' ) {
		$o->update( defined => 0 ) ;
		$obliterate?
				splice @{ $self->{data} }, $k, 1:
				delete $self->{data}->[$k] ;
		}
	elsif ( $self->{reftype} eq 'scalarref' ) {
		$o->update( defined => 0 ) ;
		delete $self->{data} ;
		}

	delete $o->{update} unless $o->{top} ;
	return $rv ;
	}

sub CLEAR {
	my $self = self( shift @_ ) ;

	my @delete = NoSQL::PL2SQL::Perldata::descendants(
			$self->{perldata}, $self->{top}, 1 ) ;
	pop @delete ;

	my @deleteok = map { $self->refcount( $_ ) } @delete ;
	$self->{delete} = \@deleteok ;

	map { delete $self->{perldata}->{$_} } @{ $self->{delete} } ;
	}

sub EXISTS {
	my $self = self( shift @_ ) ;
	my $k = shift ;

	return exists $self->{data}->{$k} ;
	}

sub FIRSTKEY {
	my $self = self( shift @_ ) ;
	$self->{keys} = [ keys %{ $self->{data} } ] ;
	return $self->NEXTKEY ;
	}

sub NEXTKEY {
	my $self = self( shift @_ ) ;
	return shift @{ $self->{keys} } ;
	}

sub debug {
	do {
		no warnings ;
		my @cc = caller ;
		my $flag = sprintf '@%d> ', $cc[-1] ;
		push @NoSQL::PL2SQL::debug, $flag .join( '|', @_ ) ;
		} ;
	}

1;
__END__