view release on metacpan or  search on metacpan

lib/SQL/Amazon/Spool.pm  view on Meta::CPAN

our $engine;

sub new {
	my ($class, $table, $reqids) = @_;
	my $keys = $table->fetch_all($reqids);
	my $metadata = $table->get_metadata();
	my $timeout = time() + $table->get_time_limit();
	my $obj = {
		_keys => $keys,
		_timeout => $timeout,
		_table => $table,
		_reqids => $reqids,
		NAME => $table->name,
		TYPE => $metadata->{TYPE},
		PRECISION => $metadata->{PRECISION},
		SCALE => $metadata->{SCALE},
		NULLABLE => $metadata->{NULLABLE},
		col_names => $metadata->{NAME},
	};

	my %colnums = ();
	$colnums{$obj->{col_names}[$_]} = $_
		foreach (0..$#{$obj->{col_names}});

	$obj->{col_nums} = \%colnums;

	return $class->SUPER::new($obj);
}

sub is_readonly { return 1; }

sub trim { 
	my $x = shift; 
	$x =~ s/^\s+//; 
	$x =~ s/\s+$//; 
	$x; 
}
sub get_metadata {
	my $obj = shift;
	
	return ($obj->{NAME}, 
		$obj->{TYPE}, 
		$obj->{PRECISION}, 
		$obj->{SCALE},
		$obj->{NULLABLE});
}
sub row {
	my $obj = shift;
	return $obj->{_currkey} ?
		$obj->{_table}->fetch($obj->{_currkey}) :
		undef;
}

sub fetch_row ($$) {
    my($obj, $handle) = @_;
	$obj->{errstr} = 'Resultset timeout has expired.',
	$obj->{_keys} = undef,
	return undef
		if (time() > $obj->{_timeout});

	my $cursor = defined($obj->{_cursor}) ?  $obj->{_cursor} : -1;
	my $keys = $obj->{_keys};
	return undef
		if ($cursor >= $#$keys);
	my $row;
	$cursor++;
	while ($cursor <= $#$keys) {
		$row = $obj->{_table}->fetch($keys->[$cursor]);
		$obj->{_currkey} = $keys->[$cursor];
		last if $row;
		$cursor++;
	}
	
	$obj->{_cursor} = $cursor;
	$obj->{errstr} = $row,
	$obj->{row} = undef,
	$obj->{_currkey} = undef,
	return undef
		unless ref $row;

	$obj->{row} = undef,
	$obj->{_currkey} = undef,
	return undef
		unless $row;

	@$row = map( $_ = &trim($_), @$row)
	    if $handle->{Database}{ChopBlanks};

    $obj->{row} = [ @$row ];
    return $obj->{row};
}

sub push_names ($$$) {
    my($obj, $data, $names) = @_;

    return undef;
}

sub push_row ($$$) {
    my($obj, $data, $fields) = @_;

	return undef;
}

sub seek ($$$$) {
    my($obj, $data, $pos, $whence) = @_;
	return 1;
}

sub drop ($$) {
    my($obj, $data) = @_;
    return undef;
}

sub truncate ($$) {
    my ($obj, $data) = @_;
    
    return undef;
}
sub DESTROY { 
	my $obj = shift;
	
	undef; 
}

1;