|
|
sybperl-l Archive
Up Prev Next
From: "W dot Phillip Moore" <wpm at ms dot com>
Subject: Out of Memory
Date: Mar 17 1999 2:25PM
diff -rc sybperl-2.10-orig/./DBlib/DBlib.pm sybperl-2.10/DBlib/DBlib.pm
*** sybperl-2.10-orig/./DBlib/DBlib.pm Fri Nov 13 16:07:05 1998
--- sybperl-2.10/DBlib/DBlib.pm Tue Mar 16 12:48:10 1999
***************
*** 409,416 ****
sub nsql {
! my ($db,$sql,$type) = @_;
my (@res,@data,%data);
if ( ref $type ) {
$type = ref $type;
--- 409,420 ----
sub nsql {
!
! my ($db,$sql,$type,$callback) = @_;
my (@res,@data,%data);
+ my $retrycount = $nsql_deadlock_retrycount;
+ my $retrysleep = $nsql_deadlock_retrysleep || 60;
+ my $retryverbose = $nsql_deadlock_verbose;
if ( ref $type ) {
$type = ref $type;
***************
*** 421,455 ****
undef $DB_ERROR;
! return unless $db->dbcmd($sql);
!
! return unless $db->dbsqlexec;
!
! while ( $db->dbresults != $db->NO_MORE_RESULTS ) {
! if ( ref $type eq "HASH" || $type eq "HASH" ) {
! while ( %data = $db->dbnextrow(1) ) {
! grep($data{$_} =~ s/\s+$//g,keys %data) if $nsql_strip_whitespace;
! push(@res,{%data});
! }
! }
! elsif ( ref $type eq "ARRAY" || $type eq "ARRAY" ) {
! while ( @data = $db->dbnextrow ) {
! grep(s/\s+$//g,@data) if $nsql_strip_whitespace;
! push(@res,( $#data == 0 ? @data : [@data] ));
! }
! }
! else {
! # If you ask for nothing, you get nothing. But suck out
! # the data just in case.
! while ( @data = $db->dbnextrow ) { 1; }
! $res[0]++; # Return non-null (true)
! }
}
#
# If we picked any sort of error, then don't feed the data back.
#
! return ( $DB_ERROR ? () : @res );
}
--- 425,527 ----
undef $DB_ERROR;
! DEADLOCK:
! {
!
! return unless $db->dbcmd($sql);
!
! unless ( $db->dbsqlexec ) {
!
! if ( $nsql_deadlock_retrycount && $DB_ERROR =~ /Message: 1205\b/m ) {
! if ( $retrycount < 0 || $retrycount-- ) {
! carp "SQL deadlock encountered. Retrying...\n" if $retryverbose;
! undef $DB_ERROR;
! sleep($retrysleep);
! next DEADLOCK;
! }
! else {
! carp "SQL deadlock retry failed $nsql_deadlock_retrycount times. Aborting.\n"
! if $retryverbose;
! last DEADLOCK;
! }
! }
!
! last DEADLOCK;
!
! }
!
! while ( $db->dbresults != $db->NO_MORE_RESULTS ) {
!
! if ( $nsql_deadlock_retrycount && $DB_ERROR =~ /Message: 1205\b/m ) {
! if ( $retrycount < 0 || $retrycount-- ) {
! carp "SQL deadlock encountered. Retrying...\n" if $retryverbose;
! undef $DB_ERROR;
! @res = ();
! sleep($retrysleep);
! next DEADLOCK;
! }
! else {
! carp "SQL deadlock retry failed $nsql_deadlock_retrycount times. Aborting.\n"
! if $retryverbose;
! last DEADLOCK;
! }
! }
!
! if ( $type eq "HASH" ) {
! while ( %data = $db->dbnextrow(1) ) {
! grep($data{$_} =~ s/\s+$//g,keys %data) if $nsql_strip_whitespace;
! if ( ref $callback eq "CODE" ) {
! unless ( $callback->(%data) ) {
! $db->dbcancel();
! $DB_ERROR = "User-defined callback subroutine failed\n";
! return;
! }
! }
! else {
! push(@res,{%data});
! }
! }
! }
! elsif ( $type eq "ARRAY" ) {
! while ( @data = $db->dbnextrow ) {
! grep(s/\s+$//g,@data) if $nsql_strip_whitespace;
! if ( ref $callback eq "CODE" ) {
! unless ( $callback->(%data) ) {
! $db->dbcancel();
! $DB_ERROR = "User-defined callback subroutine failed\n";
! return;
! }
! }
! else {
! push(@res,( $#data == 0 ? @data : [@data] ));
! }
! }
! }
! else {
! # If you ask for nothing, you get nothing. But suck out
! # the data just in case.
! while ( @data = $db->dbnextrow ) { 1; }
! $res[0]++; # Return non-null (true)
! }
!
! }
!
! last DEADLOCK;
!
}
#
# If we picked any sort of error, then don't feed the data back.
#
! if ( $DB_ERROR ) {
! return;
! }
! elsif ( ref $callback eq "CODE" ) {
! return 1;
! }
! else {
! return @res;
! }
}
diff -rc sybperl-2.10-orig/./pod/sybperl.pod sybperl-2.10/pod/sybperl.pod
*** sybperl-2.10-orig/./pod/sybperl.pod Fri Nov 6 12:32:43 1998
--- sybperl-2.10/pod/sybperl.pod Tue Mar 16 11:22:04 1999
***************
*** 813,823 ****
This value is B set by default.
! =item @ret = $dbh->nsql($sql [, "ARRAY" | "HASH" ]);
An enhanced version of the B routine, B, is also available.
! The arguments are an SQL command to be executed, and the B<$type> of
! the data to be returned. The array returned by nsql is one of the
following:
Array of Hash References (if type eq HASH)
--- 813,833 ----
This value is B set by default.
! =item @ret = $dbh->nsql($sql [, "ARRAY" | "HASH" ] [, \&subroutine ] );
An enhanced version of the B routine, B, is also available.
! nsql() provides better error checking (using its companion error and
! message handlers), optional deadlock retry logic, and several options
! for the format of the return values. In addition, the data can either
! be returned to the caller in bulk, or processes line by line via a
! callback subroutine passed as an argument (this functionality is
! similar to the r_sql() method).
!
! The arguments are an SQL command to be executed, the B<$type> of the
! data to be returned, and the callback subroutine.
!
! if a callback subroutine is not given, then the data from the query is
! returned as an array. The array returned by nsql is one of the
following:
Array of Hash References (if type eq HASH)
***************
*** 876,896 ****
of nsql.
@ret = $dbh->nsql("select stuff from table where stuff = 'nothing'","ARRAY");
! if ( $dbh->DB_ERROR() ) {
# error handling code goes here, perhaps:
! die "Unable to get stuff from table:" . $dbh->DB_ERROR() . "\n";
}
! For compatibility with older release, the error variable $DB_ERROR is
! still exported, however, direct use of this variable makes it
! difficult to pass the Sybase::DBlib object around and use the nsql()
! method for queries, since the subroutine using the object will not
! necessarily have $DB_ERROR in its namespace. The method will always
! be available.
!
! NOTE: This routine was contributed by W. Phillip Moore .
!
=back
B
--- 886,974 ----
of nsql.
@ret = $dbh->nsql("select stuff from table where stuff = 'nothing'","ARRAY");
! if ( $DB_ERROR ) {
# error handling code goes here, perhaps:
! die "Unable to get stuff from table: $DB_ERROR\n";
}
! The behavior of nsql() can be customized in several ways. If the
! variable:
+ $Sybase::DBlib::nsql_strip_whitespace
+
+ is true, then nsql() will strip the trailing white spaces from all of
+ the scalar values in the results.
+
+ When using a callback subroutine, the subroutine is passed to nsql()
+ as a CODE reference. For example:
+
+ sub parse_hash {
+ my %data = @_;
+ # Do something with %data
+ }
+
+ $dbh->nsql("select * from really_huge_table","HASH",\&parse_hash);
+ if ( $DB_ERROR ) {
+ # error handling code goes here, perhaps:
+ die "Unable to get stuff from really_huge_table: $DB_ERROR\n";
+ }
+
+ In this case, the data is passed to the callback (&parse_hash) as a
+ HASH, since that was the format specified as the second argument. If
+ the second argument specifies an ARRAY, then the data is passed as an
+ array. For example:
+
+ sub parse_array {
+ my @data = @_;
+ # Do something with @data
+ }
+
+ $dbh->nsql("select * from really_huge_table","HASH",\&parse_array);
+ if ( $DB_ERROR ) {
+ # error handling code goes here, perhaps:
+ die "Unable to get stuff from really_huge_table: $DB_ERROR\n";
+ }
+
+ The primary advantage of using the callback is that the rows are
+ processed one at a time, rather than the data returned in a huge
+ array. For very large tables, this can result in very significant
+ memory consumption, and on resource constrained machines, some large
+ queries may simply fail. Processing rows individually will be much
+ more efficient with respect to memory consumption.
+
+ IMPORTANT NOTE: The callback subroutine must return a true value if it
+ has successfully handled the data. If a false value is returned, then
+ the query is canceled via dbcancel(), and nsql() will abort further
+ processing.
+
+ WARNING: Using the following deadlock retry logic together with a
+ callback routine is dangerous. If a deadlock is encountered after
+ some rows have already been processed by the callback, then the data
+ will be processed a second time (or more, if the deadlock is retried
+ multiple times).
+
+ The nsql() method also supports automated retries of deadlock errors
+ (1205). This is disabled by default, and enabled only if the
+ variable:
+
+ $Sybase::DBlib::nsql_deadlock_retrycount
+
+ is non-zero. This variable is the number of times to resubmit a given
+ SQL query, and the variable
+
+ $Sybase::DBlib::nsql_deadlock_retrysleep
+
+ is the delay, in seconds, between retries (default is 60). Normally,
+ the retries happen silently, but if you want nsql() to carp() about
+ it, then set:
+
+ $Sybase::DBlib::nsql_deadlock_verbose
+
+ to a true value, and nsql() will whine about the failure. If all of
+ the retries fail, then nsql() will return an error, like it normally
+ does. If you want the code to try forever, then set the retry count
+ to -1.
+
=back
B
***************
*** 2000,2007 ****
--- 2078,2089 ----
Jeffrey Wong for the Sybase::DBlib DBMONEY routines.
+ W. Phillip Moore EFE for the nsql() method.
+
Numerous folks have contributed ideas and bug fixes for which they
have my undying thanks :-)
The sybperl mailing list EFE is the
best place to ask questions.
+
+ =cut
|
