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: Michael Sattler <msattler at jungle dot com>
Subject: Trapping low-level Sybase errs
Date: Mar 14 1996 12:23PM

I'm trying to trap low-level errors that aren't part of Sybperl's standard
return process.  Michael Peppler suggested the following code, which I've
modified for my HTML needs, but it's not taking.  That is to say, the code
is there, but it's not being called.  What am I doing incorrectly?

Thanks be to all.

::::::::::::::::::::
::   intro_page   :: (my main program)
::::::::::::::::::::

#!/usr/local/bin/perl

...

require support ;			# home of message_handler
&setUpExternalPackages() ;		# instantiate message_handler

...

if ( ! ($query->param('remote_user')))
	{ &provide_clean_form() ; }
else
	{ &deal_with_dirty_form() ; }

...

# ---------------------------------------------------------------------
#                          * * * Subroutines * * *
# ---------------------------------------------------------------------

sub deal_with_dirty_form {

...

	$cmd = qq( delete from cpt_session_state
		where username="$remote_user" );
	&debug( 2, "$cmd
" ) ; $global_error = 0 ; # clear Sybase error number $global_errmsg = '' ; # clear Sybase error message $ref = $d->sql( $cmd ) ; # execute the SQL command if ( $global_error ) { print "database message: $global_message

\n" ; $global_error = 0 ; # reset! } else { &debug( 2, "deleted successfully

\n" ) ; } ... :::::::::::::::::::: :: support.pm :: :::::::::::::::::::: #!/usr/local/bin/perl #--------------------------------------------------------------------- # Set up the external packages we use. #--------------------------------------------------------------------- sub main'setUpExternalPackages{ ... #------------------------------------------------------------------ # Sybperl #------------------------------------------------------------------ require 'sybperl.pl'; # ensure sybperl is here use Sybase::DBlib; # activate the class dbmsghandle (\&message_handler) ; # trap all errors $d = new Sybase::DBlib $dbUser, $dbPassword, $dbServer ; } # --------------------------------------------------------------------- # INPUT: # level - at which debug levels to emit this string # string - the debug string to be emitted # # OUT: # The text passed in, printed... # --------------------------------------------------------------------- sub main'debug { package support ; # keep support stuff together local( $level, $text ) = @_ ; # local names for in parameters if ( $main'debug > $level ) { print qq($text\n) ; } } # --------------------------------------------------------------------- # Deal with Sybase error states not returned by the execution of the # SQL statement. # --------------------------------------------------------------------- sub main'message_handler { local( $db, $message, $state, $severity, $text, $server, $procedure, $line ) = @_ ; local( $purely_informational_sybase_messages ) = 10 ; if ( $severity > $purely_informational_sybase_messages ) { print <

A database error has occurred!

The content or structure of the database used by these web pages is not what we expected. Because the program can't be sure the database is still valid, we're stopping and reporting an error message. Please copy this text and the error messages that follow into a mail message addressed to ) ; print qq(Server "$server"
) if defined ($server) ; print qq(Procedure "$procedure"
) if defined ($procedure) ; print qq(Line "$line"
) if defined ($line) ; print qq(Text "$text"

) ; if (defined($db)) { local( $lineno, $cmdbuff ) = (1, undef) ; # &dbstrcpy() returns the command buffer $cmdbuff = &Sybase::DBlib::dbstrcpy($db) ; foreach $row (split (/\n/, $cmdbuff)) { print (sprintf ("%5d", $lineno++), "> ", $row, "
\n") ; } } $global_error = $message ; $global_errmsg = $text ; } elsif ( $message == 0 ) { print qq(Text "$text"

) ; } 0 ; # required return code } # --------------------------------------------------------------------- return(1) ; # I have to do this !?! # --- script end ------------------------------------------------------ -----------------------------------------------------------------------+ Michael Sattler, Digital Jungle | San Francisco, California, USA |