view release on metacpan or  search on metacpan

examples/fetchscroll.pl  view on Meta::CPAN

# @(#)$Id: fetchscroll.pl,v 1.4 2003/01/13 23:58:53 jleffler Exp $
#
# Simulate proposed scroll cursor support for Perl DBI

use strict;
use DBI;
use Carp;

my $debug = 0;

sub fetchrow_scroll_arrayref($$$$)
{
	my($sth, $ctl, $key, $val) = @_;
	my($cur, $max, $done, $aref) = ($$ctl{currow}, $$ctl{maxrow}, $$ctl{finished}, $$ctl{array});
	my(@arr) = @$aref;
	my($inc, $abs) = (0, $cur);
	$key = lc $key;
	if    ($key eq 'first')    { $abs = 1; }
	elsif ($key eq 'next')     { $inc = +1; }
	elsif ($key eq 'prev')     { $inc = -1; }
	elsif ($key eq 'relative') { $inc = $val; }

examples/fetchscroll.pl  view on Meta::CPAN

	}
	print "\n";
}

# Defined here since referenced in test_scroll_query_sequence()
my @data =  sort "systables", "syscolumns", "sysindexes", "sysconstraints", "syschecks", "syscolauth",
            "systabauth", "syssynonyms", "sysdefaults", "sysprocedures", "sysprocauth", "sysviews",
            "sysroles", "sysroleauth", "sysusers", "systriggers", "sysprocbody", "systrigbody",
            "sysxtdtypes", "sysxtdtypeauth", "sysxtddesc", "sysreferences", "syscoldepends", "sysdepends";

sub test_scroll_query_sequence($%)
{
	my ($sth, %ops) = @_;
	my $ctl = { array => [ undef ], maxrow => 0, currow => 0, finished => 0 }; 
	my $i = 0;
	my $fail = 0;
	pr_hash(%$ctl) if $debug;
	foreach my $seq (sort { $a <=> $b } keys %ops)
	{
		my(@tst) = @{$ops{$seq}};
		my($key) = $tst[0];