This Perl script verifies the interface to DB2 whicht consists of the general database interface, called DBI, and the DB2-specific supplement, called DBD::DB2.

This script uses the xmpPerl.pm library, which is also available at this site.

#!/usr/local/bin/perl -w
use strict;

print "Perl Search Path INC ........: @INC\n";

####use lib  qw(/usr/opt/db2_08_01/lib64);
use Getopt::Std;
use vars qw($opt_d $opt_l $opt_t $opt_a);
use Env;
use Env qw (@PATH @LIBPATH @LD_LIBRARY_PATH @CLASSPATH);
use English;
use DBI;
use DBD::DB2::Constants;
use DBD::DB2;
use xmpPerl;

#################################################################################
print "PATH ........................: @PATH\n";
print "LIBPATH .....................: @LIBPATH\n";
print "LD_LIBRARY_PATH .............: @LD_LIBRARY_PATH\n";
print "CLASSPATH ...................: @CLASSPATH\n";

#################################################################################
use Getopt::Long;		
use vars qw($opt_d $opt_u $opt_p);
GetOptions("d=s","u:s","p:s");

if (! defined $opt_d )
	{print "$0 - Database nicht angegeben\n";
         SaySyntax();  }

if (! defined $opt_u ) {			# User Check
	$opt_u = xmpPerl::getDBAUser();;
	if ($opt_u eq "")
		{print "$0 - User nicht angegeben und keine lP_LUS Variable definiert\n";
        	 SaySyntax();  }
	}

if (! defined $opt_p )				# User Password Check
	{$opt_p = xmpPerl::getDBAPsw();
	if ($opt_p eq "")
		{print "$0 - User's Password fehlt und keine lP_LPW Variable definiert\n";
        	 SaySyntax();  }
	}
#################################################################################

my $stmt = "SELECT DISTINCT CREATOR FROM SYSIBM.SYSTABLES";

unlink 'dbitrace.log' if -e 'dbitrace.log';
DBI->trace( 15, 'dbitrace.log' );
print "DBI Trace Log ...............: written to dbitrace.log (current path)\n";

my $switch = DBI->internal;
$switch->debug(0);                     # 1=normal debug, 2=detailed handle trace
print "DBI Version and Attributes ..: $switch->{'Attribution'}, $switch->{'Version'}\n";
print "DBI Drivers .................: ".join(", ",DBI->available_drivers())."\n";
DBI->available_drivers();
print "Installed Versions ..........: ".join(", ",DBI->installed_versions)."\n";
DBI->installed_versions;
print "DB2 Data Sources ............: ".DBI->data_sources('DB2')." (DB2 Databases)\n";
my @data_sources = DBI->data_sources('DB2');
print "                               @data_sources\n";

my $dbh = DBI->connect("dbi:DB2:$opt_d", $opt_u, $opt_p,
                    { PrintError => 1, #       print error by default
                      RaiseError => 1, #       print error and die by default
                      AutoCommit => 0, # don't commit after each statement
                      ChopBlanks => 0, # don't remove trailing blanks on CHAR-Types
                    } );

#print "DBMS Name ...................: ".$dbh->get_info( SQL_DBMS_NAME )."\n";
#print "DBMS Version ................: ".$dbh->get_info(18)."\n";

my $sth = $dbh->prepare($stmt);
$sth->execute() || die $dbh->errstr;

print "SQL Test Statement ..........: $stmt\n";
while ( (my @row = $sth->fetchrow()) )
{print "@row\n";}

# Close Statement, Disconnect from Database ####################################
$sth->finish()   || die $dbh->errstr;
$dbh->commit     || die $dbh->errstr;
$dbh->disconnect || die $dbh->errstr;

exit 0;

sub SaySyntax {
	die "Usage: [perl] $0 -d db [-u ... -p ..] \n".
		"	-d database \n".
		"	-u user\n".
		"	-p password\n".
		"abends";
}