Networking, ODBC, & Perl
by Robert Kielsing



Example 1: 

int status = SQLGetDiagRec (data_handle_type, data_handle, 
                            record_number, &sql_state, 
                            &server_error, max_error_message_length, 
                            &error_message_length);

Example 2: 

my $status = SQLGetDiagRec ($data_handle_type, $data_handle, 
                            $record_number, $sql_state, $server_error,
                            $max_error_message_length, $error_message_length);



Example 3: 

$SIG{TERM} = sub { 
    `rm -f /usr/local/var/odbcbridge/odbcbridge.pid` ; exit 0 
    }; 


Example 4: 

($r, $sqlstate, $native, $text, $textlen) = 
  $client -> sql_get_diag_rec ($SQL_HANDLE_DBC, $cnh, 1, 255);


Example 5: 

require Net::Daemon;
require RPC::PlServer;
require IO::Socket;
use UnixODBC ':all';
package UnixODBC::BridgeServer;
use vars qw($VERSION @ISA);
$UnixODBC::BridgeServer::VERSION = $UnixODBC::VERSION;
@UnixODBC::BridgeServer::ISA = qw(RPC::PlServer);
sub new {
    my $self = shift -> SUPER::new(@_);
}


Example 6: 

my $clienthost = 'aardvark';
if (ref($client) =~ /RPC::PlClient/) {
    $client -> Log ('notice', "Connect from $clienthost.");
}

Example 7: 

<Directory "/usr/local/apache/htdocs/datamanager">
    Options FollowSymLinks Includes
    AllowOverride All
</Directory>
AddType text/html .shtml
AddHandler server-parsed .shtml

Example 8: 

my $client =
    eval { RPC::PlClient->new('peeraddr' => 'aardvark',
                  'peerport' => 9999,
                  'application' => 'RPC::PlServer',
                  'version' => $UnixODBC::VERSION,
                  'user' => 'peerusername',
                  'password' => 'peerpassword') }
or print 
    qq|<p>Failed to make first connection to $peeraddr: $@</p>|;


Example 9: 

sub client_error {
    my ($errno, $func, $text) = @_;
    print qq|<font size="5">Error</font><p>\n|;
    print qq|<pre>ODBC Error Code: $errno</pre><p>\n|;
    print qq|<pre>[$func]$text</pre>\n|;
}
$r = $c -> sql_free_handle ($SQL_HANDLE_ENV, $evh);
if ($r != 0) {
    ($rerror, $sqlstate, $native, $text, $textlen) = 
    $c -> sql_get_diag_rec ($SQL_HANDLE_ENV, $evh, 1, 255);
    &client_error ($r, 'free_connect cnh', $text);
}


Listing One
SQLRETURN 
SQLGetDiagRec (handle_type,handle,rec_number,sqlstate,native,
               message_text,buffer_length,text_length_ptr)
        SQLSMALLINT handle_type;
        SQLHANDLE   handle
        SQLSMALLINT rec_number;
        char *sqlstate;
        SQLINTEGER native;
        char *message_text;
        SQLSMALLINT buffer_length;
        SQLSMALLINT text_length_ptr;

    PREINIT:
    SQLCHAR *st = (SQLCHAR*) safemalloc (buffer_length);
    SQLCHAR *text = (SQLCHAR*) safemalloc (buffer_length);
    SQLINTEGER *nat = (SQLINTEGER*) safemalloc (sizeof(int));
    SQLSMALLINT *len = (SQLSMALLINT*) safemalloc (sizeof(int));

        CODE:
        RETVAL = SQLGetDiagRec ( handle_type, handle, rec_number, st,
                                 nat, text, buffer_length, len );
        sv_setpv (ST(3), st);
    sv_setiv (ST(4), *nat);
        sv_setpv (ST(5), text);
        sv_setiv (ST(7), *len);
        OUTPUT:
                RETVAL


Listing Two
#! /usr/bin/perl
use UnixODBC qw(:all);
my $evh;                                   # Environment Handle
my $r;                                     # Return Value
my ($rerr, $state, $native, $text, $len);  # GetDiagRec
my ($desc, $desc_len, $attr, $attr_len);   # SQLDrivers

$r = SQLAllocEnv ($evh);
if (! defined $evh) {
    print "Could not allocate environment handle: $r\n";
    exit 1;
}

# Try a Level 3 function.
$r = SQLSetEnvAttr($evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC3, 0);

# If not successful, try a Level 2 function.
if ($r != $SQL_SUCCESS) {
    $r = SQLDrivers ( $evh, $SQL_FETCH_FIRST, $desc, 255, $desc_len,
              $attr, 255, $attr_len );
    if (($r != $SQL_SUCCESS) || ($r != $SQL_SUCCESS_WITH_INFO)) {
    print "$r";
    exit 1;
    }
    print "ODBC Level 2 supported\n";
    exit 1;
}
# Try some other Level 3 functions.
$r = SQLFreeHandle ($SQL_HANDLE_ENV, $evh);
if ($r == $SQL_SUCCESS) {
    print "ODBC Level 3 supported.\n";
} else {
    $rerr = SQLGetDiagRec ($SQL_HANDLE_ENV, $evh, 
                           $state, $native, $text, 255, $len);
    print "$text\n";
    exit 1;
}

Listing Three 
(available electronically)

Listing Four
#! /bin/sh
# 
# Edit LD_LIBRARY_PATH with all the directories of the libraries 
# that ODBC needs to find.
#
LD_LIBRARY_PATH="/usr/local/lib:/usr/local/mysql/lib:/usr/lib:/lib" 
export LD_LIBRARY_PATH
case "$1" in
  start)
    echo "Starting ODBC bridge... "
    /usr/local/sbin/server &
    ;;
  stop)
    echo "Stopping ODBC bridge... "
        kill `cat /usr/local/var/odbcbridge/odbcbridge.pid`
    ;;
  *)
    echo "Usage: odbcserver {start|stop}" >&2
    exit 1
    ;;
esac
exit 0

Listing Five
#! /usr/local/bin/perl
require 5.004;
use strict;

require RPC::PlClient;
use UnixODBC qw (:all);
use UnixODBC::BridgeServer;

my $client = 
    eval { RPC::PlClient->new('peeraddr' => 'remotehost', 'peerport' => 9999,
              'application' => 'RPC::PlServer',
              'version' => $UnixODBC::VERSION, 
                          'user' => 'kiesling', 'password' => 'password') }
    or print "Failed to make first connection: $@\n";
my $c = $client -> ClientObject ('BridgeAPI', 'new');
my $evh;  
my ($r, $sqlstate, $native, $text, $textlen);
my ($dsn, $dsnlength, $driver, $driverlength);
$evh =  $c -> sql_alloc_handle ($SQL_HANDLE_ENV, $SQL_NULL_HANDLE);
$r = $c -> 
    sql_set_env_attr ($evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC2, 0);
($r, $sqlstate, $native, $text, $textlen) = 
    $c -> sql_get_diag_rec ($SQL_HANDLE_ENV, $evh, 1, 255);
($r, $dsn, $dsnlength, $driver, $driverlength) = 
    $c -> sql_data_sources ($evh, $SQL_FETCH_FIRST, 255, 255);
print "$dsn, $driver\n";
while (1) {
($r, $dsn, $dsnlength, $driver, $driverlength) = 
    $c -> sql_data_sources ($evh, $SQL_FETCH_NEXT, 255, 255);
    last unless $r == $SQL_SUCCESS;
    print "$dsn, $driver\n";
}
$r = $c -> sql_free_handle ($SQL_HANDLE_ENV, $evh);
($r, $sqlstate, $native, $text, $textlen) = 
    $c -> sql_get_diag_rec ($SQL_HANDLE_ENV, $evh, 1, 255);

Listing Six 
(available electronically)






6


