|
|
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;
}
|
