PEPPLER.ORG
Michael Peppler
Sybase Consulting
Menu
Home
Sybase on Linux
Install Guide for Sybase on Linux
General Sybase Resources
General Perl Resources
Freeware
Sybperl
Sybase::Simple
DBD::Sybase
BCP Tool
Bug Tracker
Mailing List Archive
Downloads Directory
FAQs
Sybase on Linux FAQ
Sybperl FAQ
Personal
Michael Peppler's resume

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