sybperl-l Archive

From: Michael Peppler <mpeppler at MBAY dot NET>
Subject: sybperl works
Date: Feb 12 1999 12:00AM

>>>>> "David" == David Hajoglou  writes:

David> I got sybperl to work finally.  However, as I am having trouble
David> with using globals and mod_perl and such, I don't know if I can
David> use this specific line of code.  I am creating a hash of
David> database handles with this line of code $dbh{$user}=new
David> Sybase::DBlib $user, $sent_pw, $server; I want to be able to
David> create, destroy, and access these handles individually.  Am I
David> able to cerate such global handles?  And, is this a good way to
David> achieve persistant connections?

No, that's not a good way.

Below is a version of Apache::Sybase::DBlib, initially written by
Brian P. Millet, and which I've retouched slightly. This should give
you a decent starting point.

Michael
-- 
Michael Peppler         -||-  Data Migrations Inc.
mpeppler@mbay.net       -||-  http://www.mbay.net/~mpeppler
Int. Sybase User Group  -||-  http://www.isug.com
Sybase on Linux mailing list: ase-linux-list@isug.com


package Apache::Sybase::DBlib;


use Sybase::DBlib;
use strict;

@Apache::Sybase::DBlib::ISA = qw(Sybase::DBlib);

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

        my($row);
    if ($severity > 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 = &Sybase::DBlib::dbstrcpy($db);

            foreach $row (split (/\n/, $cmdbuff))
            {
                print STDERR (sprintf ("%5d", $lineno ++), "> ", $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;
}

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

my %Connected;

*Apache::Sybase::DBlib::new = \&connect;

sub connect {
    my($self, @args) = @_;
    foreach (@args) {
	$_ = '' unless $_;
    }
    my($Uid, $Pwd, $Srv) = @args;
    my $idx = join(":", @args);

#    foreach (keys(%Connected)) {
#	print STDERR "Connected: $_\n";
#    }
    if($Connected{$idx} && ping($Connected{$idx})) {
	warn "Already connected to $idx" if $main::DEBUG;
	return bless($Connected{$idx}, "Apache::Sybase::DBlib");
    }
    print STDERR "connecting to $idx from $$\n" if $main::DEBUG;
    my $dbh = Sybase::DBlib->dblogin($Uid, $Pwd, $Srv, "Apache-$$");

    if(!$dbh) {
	return undef;
    }

    $Connected{$idx} = $dbh;

#    print STDERR "$Connected{$idx}\n";

    bless($Connected{$idx}, "Apache::Sybase::DBlib");
}

sub DESTROY {
    print STDERR "DESTROY called!!\n";
    1;
}

# Yuck!
sub ping {
    my $dbh = shift;

    my $ret = $dbh->sql("select getdate()");

    $ret;
}

1;

__END__

=head1 NAME

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

=head1 SYNOPSIS

 use Apache::Sybase::DBlib;

 $dbh = Apache::Sybase::DBlib->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 
 Apache::DBI by Edmund Mergl 

----------------------------------------------------
#       @(#)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->header();
print $obj->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 "
Test of Apache::Sybase::DBlib
\n";
print "
\nSybperl Version $Version\n";

( $X = Apache::Sybase::DBlib->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->dbuse('master') == &Apache::Sybase::DBlib::SUCCEED )
    and print("ok 2\n")
    or print "not ok 2\n";

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

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

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

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

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

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

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

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

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

$err = 0;
while(@row = $X->dbnextrow) {
        $rows++;
        ++$err if($X->{DBstatus} != &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:

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

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

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

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

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

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

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

$ref = $X->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 "
\n";

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

        if ($severity > 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");

                # &dbstrcpy returns the command buffer.

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

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

                        foreach $row (split (/\n/, $cmdbuff)) {
                                print STDERR (sprintf ("%5d", $lineno ++), "> ", $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 > 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