sybperl-l Archive

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        |