<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Apache::Sybase::DBlib;


use Sybase::DBlib;
use strict;

sub message_handler
{
    my ($db, $message, $state, $severity, $text, $server, $procedure, $line)
        = @_;

        my($row);
    if ($severity &gt; 0)
    {
        print STDERR ("Sybase message ", $message, ", Severity ", $severity,
               ", state ", $state);
        print STDERR ("\nServer `", $server, "'") if defined ($server);
        print STDERR ("\nProcedure `", $procedure, "'") if defined ($procedure);
        print STDERR ("\nLine ", $line) if defined ($line);
        print STDERR ("\n    ", $text, "\n\n");

        if(defined($db))
        {
            my ($lineno, $cmdbuff) = (1, undef);

            $cmdbuff = &amp;Sybase::DBlib::dbstrcpy($db);

            foreach $row (split (/\n/, $cmdbuff))
            {
                print STDERR (sprintf ("%5d", $lineno ++), "&gt; ", $row, "\n");
            }
        }
    }
    elsif ($message == 0)
    {
        print STDERR ($text, "\n");
    }

    0;
}

sub error_handler {
    my ($db, $severity, $error, $os_error, $error_msg, $os_error_msg)
        = @_;
    # Check the error code to see if we should report this.
    if ($error != SYBESMSG) {
        print STDERR ("Sybase error: ", $error_msg, "\n");
        print STDERR ("OS Error: ", $os_error_msg, "\n") if defined ($os_error_msg);
    }

    INT_CANCEL;
}

&amp;dbmsghandle ("message_handler"); # Some user defined error handlers
&amp;dberrhandle ("error_handler");

my(%Connected);

sub connect {
    my($self, @args) = @_;
        my($Uid, $Pwd, $Srv) = @args;
    my $idx = join ":", (@args) || (@{$self});
    return $Connected{$idx} if $Connected{$idx};
    print STDERR "connecting to $idx...\n" if $main::DEBUG;
    $Connected{$idx} = Sybase::DBlib-&gt;dblogin($Uid, $Pwd, $Srv);
}

sub DESTROY {
}

1;

__END__

=head1 NAME

Apache::Sybase::DBlib - persistent database connection via DBlib

=head1 SYNOPSIS

 use Apache::Sybase::DBlib;

 $dbh = Apache::Sybase::DBlib-&gt;connect($Uid, $Pwd, $Srv);

=head1 DESCRIPTION

This module provides a persistent database connection via Sybase DBlib.

All you really need is to replace Sybase::Ctlib with Apache::Sybase.
When connecting to a database the module looks if a database
handle from a previous connect request is already stored. If
not, a new connection is established and the handle is stored
for later re-use. The destroy method has been intentionally
left empty.

=head1 SEE ALSO

Apache(3)

=head1 AUTHORS

 mod_perl by Doug MacEachern &lt;dougm@osf.org&gt;
 Apache::DBI by Edmund Mergl &lt;E.Mergl@bawue.de&gt;

----------------------------------------------------
#       @(#)dblib.t     1.17    2/20/96

package TEST;

use CGI::Switch;
use Apache::Sybase::DBlib;

$obj = new CGI::Switch;

$ENV{'SYBASE'}="xxxxxxxx"; Sorry, let you fill in the xxxxx!!
$ENV{'DSQUERY'}="xxxxxxxx";
$Srv = $ENV{'DSQUERY'};
$Uid = "xxxx";
$Pwd = "xxxxxxxx";
$database = "xxx";

my($rows,$count, $ref);
$rows=0; $count=0; $ref="";

print $obj-&gt;header();
print $obj-&gt;start_html("Test of Apache::Sybase::DBlib");

# This test file is still under construction...
$Version = $SybperlVer;
$Version = $Sybase::DBlib::Version;
$Sybase::DBlib::Att{UseDateTime} = TRUE;

print "&lt;H1&gt;Test of Apache::Sybase::DBlib&lt;/H1&gt;\n";
print "&lt;PRE&gt;\nSybperl Version $Version\n";

( $X = Apache::Sybase::DBlib-&gt;connect($Uid, $Pwd, $Srv) )
    and print("ok 1\n")
    or print "not ok 1
-- The supplied login id/password combination may be invalid\n";

( $X-&gt;dbuse('master') == &amp;Apache::Sybase::DBlib::SUCCEED )
    and print("ok 2\n")
    or print "not ok 2\n";

($X-&gt;dbcmd("select count(*) from systypes") == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 3\n")
    or print "not ok 3\n";

($X-&gt;dbsqlexec == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 4\n")
    or print "not ok 4\n";

($X-&gt;dbresults == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 5\n")
    or print "not ok 5\n";

($count) = $X-&gt;dbnextrow;
($X-&gt;{DBstatus} == &amp;Apache::Sybase::DBlib::REG_ROW)
    and print "ok 6\n"
    or print "not ok 6\n";

$X-&gt;dbnextrow;
($X-&gt;{DBstatus} == &amp;Apache::Sybase::DBlib::NO_MORE_ROWS)
    and print "ok 7\n"
    or print "not ok 7\n";

($X-&gt;dbresults == &amp;Apache::Sybase::DBlib::NO_MORE_RESULTS)
    and print("ok 8\n")
    or print "not ok 8\n";

($X-&gt;dbcmd("select * from systypes") == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 9\n")
    or print "not ok 9\n";

($X-&gt;dbsqlexec == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 10\n")
    or print "not ok 10\n";

($X-&gt;dbresults == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 11\n")
    or print "not ok 11\n";

$err = 0;
while(@row = $X-&gt;dbnextrow) {
        $rows++;
        ++$err if($X-&gt;{DBstatus} != &amp;Apache::Sybase::DBlib::REG_ROW);
}
($err == 0)
    and print("ok 12\n")
    or print "not ok 12\n";

($count == $rows)
    and print "ok 13\n"
    or print "not ok 13, count=|$count|, rows=|$rows|\n";

# Now we make a syntax error, to test the callbacks:

&amp;Sybase::DBlib::dbmsghandle (\&amp;msg_handler); # different handler to check callbacks

($X-&gt;dbcmd("select * from systypes\nwhere") == &amp;Apache::Sybase::DBlib::SUCCEED)
    and print("ok 14\n")
    or print "not ok 14\n";

($X-&gt;dbsqlexec == &amp;Apache::Sybase::DBlib::FAIL)
    and print("ok 16\n")
    or print "not ok 16\n";

&amp;Apache::Sybase::DBlib::dbmsghandle ("message_handler"); # Some user defined error handlers

$date1 = $X-&gt;newdate('Jan 1 1995');
$date2 = $X-&gt;newdate('Jan 3 1995');

($date1 &lt; $date2)
    and print "ok 17\n"
    or print "not ok 17\n";

($days, $msecs) = $date1-&gt;diff($date2);
($days == 2 &amp;&amp; $msecs == 0)
    and print "ok 18\n"
    or print "not ok 18\n";

$ref = $X-&gt;sql("select getdate()");
(ref (${$$ref[0]}[0]) eq 'Apache::Sybase::DBlib::DateTime')
        and print "ok 19\n"
    or print "not ok 19, ref=|",ref(${$$ref[0]}[0]),"|, value=|",${$$ref[0]}[0],"|\n";

print "&lt;/PRE&gt;&lt;/BODY&gt;&lt;/HTML&gt;\n";

sub message_handler {
        my ($db, $message, $state, $severity, $text, $server, $procedure, $line)
                = @_;

        if ($severity &gt; 0) {
                print STDERR ("Sybase message ", $message, ", Severity ", $severity,
                                          ", state ", $state);
                print STDERR ("\nServer `", $server, "'") if defined ($server);
                print STDERR ("\nProcedure `", $procedure, "'") if defined ($procedure);
                print STDERR ("\nLine ", $line) if defined ($line);
                print STDERR ("\n    ", $text, "\n\n");

                # &amp;dbstrcpy returns the command buffer.

                if(defined($db)) {
                        my ($lineno, $cmdbuff) = (1, undef);

                        $cmdbuff = &amp;Apache::Sybase::DBlib::dbstrcpy($db);

                        foreach $row (split (/\n/, $cmdbuff)) {
                                print STDERR (sprintf ("%5d", $lineno ++), "&gt; ", $row, "\n");
                        }
                }
        } elsif ($message == 0) {
                print STDERR ($text, "\n");
        }

    1;
}

sub error_handler {
    my ($db, $severity, $error, $os_error, $error_msg, $os_error_msg)
                = @_;
    # Check the error code to see if we should report this.
    if ($error != SYBESMSG) {
                print STDERR ("Sybase error: ", $error_msg, "\n");
                print STDERR ("OS Error: ", $os_error_msg, "\n") if defined ($os_error_msg);
    }

    INT_CANCEL;
}

sub msg_handler {
        my ($db, $message, $state, $severity, $text, $server, $procedure, $line)
                = @_;

        if ($severity &gt; 0) {
                ($message == 102)
                        and print("ok 15\n")
                                or print("not ok 15\n");
        }
        1;
}

----------------------------------
Last but not least, the screen dump from Netscape:
Test of Apache::Sybase::DBlib

Sybperl Version This is sybperl, version 2.07

Sybase::DBlib version 1.31 02/04/97

Copyright (c) 1991-1997 Michael Peppler


ok 1
ok 2
ok 3
ok 4
ok 5
ok 6
ok 7
ok 8
ok 9
ok 10
ok 11
ok 12
ok 13
ok 14
ok 15
ok 16
ok 17
ok 18
not ok 19, ref=||, value=|Mar 19 1997  8:12:42:713PM|

Now I have a BIG question about test 19.  The ref item is a date, but
ref(date) is null.  ??????

Sorry, but I will not have any time to maintain or update this
module.  ANYONE who wants to take it over and put their name on it is
OK with me.

--
Brian Millett
Technology Applications Inc.     "Heaven can not exist,
(314) 530-1981                          If the family is not eternal"
bpm@techapp.com                   F. Ballard Washburn

</pre></body></html>