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: jmcallister at dtint dot com
Subject: Re: Interfaces entry
Date: Mar 6 2001 5:02PM

> I want to override the interfaces file name - is it possible to set
> attributes on the end of  "new Sybase::CTlib..." or is there another way
- I
> cant change the open client directory, but want to build a 'dynamic'
> interfaces entry.

The relevant function for changing the interfaces file path dynamically is
ct_config(). It's described in the Sybase CT-Lib manual. Here's some code
you might find edifying (or at least amusing). Many times my scripts know
the hostname and port number of a SQL server, but not the server name. In
fact, it might not even be in the local interfaces file. I use ct_config()
to use a temporary interfaces file that has the desired hostname/port
combo. You might also like the way tuck the connection parameters into the
database handle. If a connection is lost, the handle has all the
information necessary to reconnect. Note: the interfaces file format is OS
dependent.

Cheers,

James McAllister
Digital Technology Int'l

-------  -------


################################################################################
#
# tli_addr(hostname, port)
#
# Given a hostname and port number, returns the tli address as used in
Solaris
# interfaces files. NOTE: This requires a reverse lookup, which may hit a
DNS.
#
################################################################################

sub tli_addr {

     my($hostname, $port) = @_;

     # Get the hostent structure. Complain if the entry wasn't found.
     #
     my($name, $aliases, $addrtype, $length, @addrs) = gethostbyname
($hostname);

     if (! defined $name) {
          complain(
               "Unable to get an IP address for $hostname: $!.",
               "Check your hosts file and/or DNS setup."
          );
          return undef;
     }

     # Extract the IP octets.
     #
     my($a, $b, $c, $d) = unpack('C4', $addrs[0]);

     # Convert the IP and port number to embedded hex digits.
     #
     sprintf("\\x0002%.4x%.2x%.2x%.2x%.2x%.16x", $port, $a, $b, $c, $d, 0);
}

################################################################################
#
# db_connect2(user, password, hostname, port, database, packetsize)
#
# Logs into the SQL server (using hostname and port number instead of SQL
# server name) and returns a database handle. Creates a temporary
interfaces
# file to hold a dummy entry for the server. Attempts to use the database.
#
################################################################################

sub db_connect2 {

     my($user, $password, $hostname, $port, $database, $packetsize) = @_;
     my $dbh = undef;

     $packetsize = $::gParams{network_pktsz} unless defined $packetsize;

     # Open a temporary interfaces file. Use the PID to avoid stepping
     # on concurrent Sybperl scripts.
     #
     my $interfaces = $::gParams{tempdir}.$::gParams{slash}."interfaces.".
$$;
     if (! open(INTERFACES, ">$interfaces")) {
          complain(
               qq(Unable to open temporary interfaces file $interfaces
while logging into host "$hostname" (port $port): $!),
               qq(This is an internal program error and should not occur.),
               qq(Contact DTI Technical Support for assistance.)
          );
          return undef;
     }

     # The contents of interfaces is OS dependent.
     #
     if ($::gParams{os} eq 'MSWin32') {
          print INTERFACES "[SYBASE]\nquery=NLWNSCK,$hostname,$port\n";
     }
     elsif ($::gParams{os} eq 'solaris') {
          my $hex = tli_addr($hostname, $port);
          print INTERFACES "SYBASE\n\tquery tli tcp /dev/tcp $hex\n\n\n";
     }
     else {
          abort(qq(db_connect2: Unknown operating system: "$::gParams{os}"
\n));
     }
     close(INTERFACES);

     # Save the original interfaces pathname.
     #
     my $orig_interfaces;
     my $ret = ct_config(CS_GET, CS_IFILE, $orig_interfaces, CS_CHAR_TYPE);
     if ($ret == CS_FAIL) {
          complain(
               "Unable to get original interfaces pathname.",
               "This is an internal program error and should not occur.",
               "Contact DTI Technical Suppport for assistance."
          );
     }

     # Use the temporary interfaces file.
     #
     $ret = ct_config(CS_SET, CS_IFILE, $interfaces, CS_CHAR_TYPE);
     if ($ret == CS_FAIL) {
          complain(
               "Unable to set interfaces file to $interfaces.",
               "This is an internal program error and should not occur.",
               "Contact DTI Technical Suppport for assistance."
          );
          return undef;
     }

     # Log in at the requested packet size.
     #
     $dbh = new Sybase::CTlib $user, $password, 'SYBASE',
$::gParams{program}, {
          CON_PROPS => {
               CS_HOSTNAME       => $::gParams{localhost},
               CS_PACKETSIZE     => $packetsize,
               CS_SEC_ENCRYPTION => CS_TRUE
          },
          DTI_CON_METHOD  => 'host_and_port',
          DTI_USER       => $user,
          DTI_PASSWORD   => $password,
          DTI_HOSTNAME   => $hostname,
          DTI_PORT       => $port,
          DTI_PACKETSIZE => $packetsize,
          DTI_DATABASE   => $database
     };

     # If it failed, try again with a smaller packet size (512).
     #
     if (! $dbh) {
          $dbh = new Sybase::CTlib $user, $password, 'SYBASE',
$::gParams{program}, {
               CON_PROPS => {
                    CS_HOSTNAME       => $::gParams{localhost},
                    CS_PACKETSIZE     => 512,
                    CS_SEC_ENCRYPTION => CS_TRUE
               },
               DTI_CON_METHOD  => 'host_and_port',
               DTI_USER       => $user,
               DTI_PASSWORD   => $password,
               DTI_HOSTNAME   => $hostname,
               DTI_PORT       => $port,
               DTI_PACKETSIZE => 512,
               DTI_DATABASE   => $database
          };

          # If the logon succeeds, complain because network packet size
          # shouldn't be set that low.
          #
          complain(
               qq(Connection to host "$hostname" (port $port) succeeded,
but not at the requested packet size $packetsize.),
               qq(Check sp_configure values for "max network packet size"
and "default network packet size".)
          ) if $dbh;
     }

     # Restore the original interfaces file and remove the temporary one.
     #
     if (-f $orig_interfaces) {
          ct_config(CS_SET, CS_IFILE, $orig_interfaces, CS_CHAR_TYPE);
          if ($ret == CS_FAIL) {
               complain(
                    "Unable to reset interfaces file to $orig_interfaces.",
                    "This is an internal program error and should not
occur.",
                    "Contact DTI Technical Suppport for assistance."
               );
               return undef;
          }
     }
     unlink $interfaces if -f $interfaces;

     # Complain if the login failed. Leave it to the calling routine to
decide
     # if it's worth aborting over.
     #
     if (! $dbh) {
          complain(
               qq(Unable to connect to host "$hostname" (port $port) as
$user.),
               qq(Is your password correct?)
          );
          return undef;
     }

     # Attempt to use the database if one has been given.
     #
     if ($database && $database ne 'default') {

          $dbh->ct_sql("use $database");
          if ($dbh->{RC} == CS_FAIL) {
               complain(
                    qq(Couldn't use database "$database" on host
"$hostname" (port $port).),
                    qq(Either the database name is incorrect, or the
database has not recovered yet.)
               );
               return undef;
          }
     }

     # Turn off character set conversion.
     #
     $dbh->ct_sql("set char_convert off");
     if ($dbh->{RC} == CS_FAIL) {
          complain(qq(Couldn't turn off character set conversion for host
"$hostname" (port $port).));
          return undef;
     }

     $dbh;
}

################################################################################
#
# test_and_reconnect(dbh, retries, interval)
#
# Tests a database handle to see if it is still connected to a SQL server
# and able to query it. If not, it attempts to reconnect. You can specify
the
# number of times to attempt connecting and the seconds to sleep between
them.
# You could use this to recover from failover events.
#
# Returns the tested and possibly reconstitued database handle.
#
################################################################################

sub test_and_reconnect {

     my($dbh, $retries, $interval) = @_;

     # If the handle is already undefined, we can't do much with it.
     #
     if (! defined $dbh) {
          complain(
               "Unable to test and reconnect a database handle that is
undefined.",
               "The original connection was likely never valid."
          );
          return undef;
     }

     # If the connection isn't marked dead, we might have to try something
     # simple before it realizes it is dead.
     #
     my $ultimate_answer = 0;
     if (! $dbh->DBDEAD) {
          if ($dbh->ct_execute('select 42') == CS_SUCCEED) {
               my $restype;
               while ($dbh->ct_results($restype) == CS_SUCCEED) {
                    next unless $dbh->ct_fetchable($restype);
                    $ultimate_answer = ($dbh->ct_fetch())[0];
                    $dbh->ct_cancel(CS_CANCEL_ALL);
               }
          }
     }

     # If it worked as expected, the database handle must be good so we
     # can just return it.
     #
     return $dbh if $ultimate_answer == 42 && ! $dbh->DBDEAD;

     # Retrieve parameters we cleverly tucked away in the handle.
     #
     my $con_method = $dbh->{DTI_CON_METHOD};
     my $user = $dbh->{DTI_USER};
     my $password = $dbh->{DTI_PASSWORD};
     my $database = $dbh->{DTI_DATABASE};
     my $packetsize = $dbh->{DTI_PACKETSIZE};
     my($server, $hostname, $port);
     if ($con_method eq 'server') {
          $server = $dbh->{DTI_SERVER};
     }
     elsif ($con_method eq 'host_and_port') {
          $hostname = $dbh->{DTI_HOSTNAME};
          $port = $dbh->{DTI_PORT};
     }
     else {
          complain("The connection has been marked dead, but couldn't
determine connection method.");
          return undef;
     }
     $retries = 1 unless defined $retries;         # Maximum login
attempts.
     $interval = 10 unless defined $interval;      # Secs to sleep between
tries.

     # Try logging in. If unsuccessful sleep for a while and try again.
     #
     $dbh = undef;
     for (my $i = 0; $i < $retries; $i++) {
          if ($con_method eq 'server') {
               complain(
                    "The connection to $server is dead.",
                    "Will attempt reconnect in $interval seconds."
               );
               sleep $interval;
               $dbh = db_connect($user, $password, $server, $database,
$packetsize)
          }
          else {
               complain(
                    qq(The connection to host "$hostname" (port $port) is
dead.),
                    qq(Will attempt to reconnect in $interval seconds.)
               );
               sleep $interval;
               $dbh = db_connect2($user, $password, $hostname, $port,
$database, $packetsize)
          }
          last if $dbh;
     }

     $dbh;
}