Errata

The site - http://www.xmlproj.com/PPM no longer exists:
The xmlproj.com domain was apparently hijacked by an unscrupulous ISP.

Windows binaries ( just version 8i I believe ) may be
found at ftp://ftp.esoftmatic.com/outgoing/DBI

The code in Example 3-1 is missing Step 5.

It says:

---
# Step 5: Launch the Perl/Tk looping process, to display window.MainLoop();
---

It should say:

---
# Step 5: Launch the Perl/Tk looping process, to display window.

MainLoop();
---

The full example, as it should be, is below:

========== Code should be as below ==============

#!/usr/bin/perl

use strict;
use warnings;

# Step 1: Get hold of the main Perl/Tk package.

use Tk;

# Step 2: Create the Main Window. Use the name of the program,
# held in the special Perl variable $0, to create the title.

my $mw = MainWindow->new(-title=>$0);

# Step 3: Pack a label onto the screen to hold our initial message.

$mw->Label(-text=> "Hello Perl/Tk", -anchor=>'center'
)->pack(-side=>'top');

# Step 4: Create a button to neatly exit the program.

$mw->Button( -text=>'Exit',
-command=>&doExit )->pack(-side=>'bottom');

# Step 5: Launch the Perl/Tk looping process, to display window.MainLoop();

MainLoop();

# Step 6: Create an exit subroutine.

sub doExit { exit 0; }

========== Code should be as above ==============

In Example 7-3, please change the following two lines (they work
on Solaris, but not Linux):

===
bless $dbh => 'OCIEnvPtr';
OCIHandleAlloc($dbh, my $dschp, OCI_HTYPE_DESCRIBE, 0, 0);
===

to

===
bless $dbh => 'OCIEnvPtr';
OCIHandleAlloc($dbh, my $dschp, OCI_HTYPE_DESCRIBE, 0, 0);

# Alternative to two lines above, if they fail to work on your OS.
#my $env = get_oci_handle($dbh, OCI_HTYPE_ENV);
#OCIHandleAlloc($env, my $dschp, OCI_HTYPE_DESCRIBE, 0, 0);
===

The bottom two lines work on Linux.

The full example is now:

========== Code should be as below ==============

#!/usr/bin/perl -w

use strict;

# Blended DBI and OCI

use DBI qw(neat);
use Oracle::OCI qw(:all);
# Step 1: Get the environment right, and set up your target
# database and user.
$ENV{ORACLE_SID} ||= 'ORCL';
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';

# Steps 2 & 3: We initialize and log onto the database.
my ($user, $pass) = split ///, $dbuser;
my $dbh = DBI->connect("dbi:Oracle:$ENV{ORACLE_SID}", $user, $pass);

# Step 4: Now prepare the description of the target table, this time
# using OCI, after we've established our connection with DBI.
# Notice the frequent use of the Perl DBI $dbh variable.
my $tablename = $ARGV[0];

bless $dbh => 'OCIEnvPtr';
OCIHandleAlloc($dbh, my $dschp, OCI_HTYPE_DESCRIBE, 0, 0);

# Alternative to two lines above, if they fail to work on your OS.
#my $env = get_oci_handle($dbh, OCI_HTYPE_ENV);
#OCIHandleAlloc($env, my $dschp, OCI_HTYPE_DESCRIBE, 0, 0);

bless $dschp => 'OCIDescribePtr';
OCIDescribeAny ($dbh, $dbh, oci_buf_len($tablename), OCI_OTYPE_NAME,
1, OCI_PTYPE_TABLE, $dschp);

# Get the parameter descriptor.

OCIAttrGet ($dschp, OCI_HTYPE_DESCRIBE, my $parmp, 0, OCI_ATTR_PARAM,
$dbh, 'OCIDescribePtr');

# Get the table list, number of columns and description.

OCIAttrGet ($parmp, OCI_DTYPE_PARAM, my $collst, 0,
OCI_ATTR_LIST_COLUMNS, $dbh, 'OCIParamPtr');

OCIAttrGet ($parmp, OCI_DTYPE_PARAM, my $numcols, 0,
OCI_ATTR_NUM_COLS, $dbh, 'OCIParamPtr');
my $errstr;

# Describe the target table.

printf ("
------------------
");
printf ("TABLE : %s
", $tablename);
printf ("------------------
");

my %col_attr = (
OCI_ATTR_NAME => "ColName",
OCI_ATTR_IS_NULL => "NULL?",
);

my $status;
foreach my $colnum (1..$$numcols) {

my $col_parmdp_int = 0;
my $col_parmdp = bless $col_parmdp_int => 'OCIParamPtr';
OCIParamGet($collst, OCI_DTYPE_PARAM, $dbh, $col_parmdp, $colnum);

my $describe_attr = {
OCI_ATTR_NAME => 0,
OCI_ATTR_IS_NULL => 1,
};

printf "
";
foreach my $attr (sort keys %$describe_attr) {
my $type = $describe_attr->{$attr};
no strict 'refs';
$status = OCIAttrGet( $col_parmdp, OCI_DTYPE_PARAM,
oci_buf_len(my $tmp, 90),
&$attr, $dbh, $type);
warn "$attr: ".get_oci_error($dbh, $status, 'OCIAttrGet')
if $status;
warn get_oci_error($dbh, $status) if $status;
printf "%-20s: %s
", $col_attr{$attr}, neat($tmp);
}
}

# Steps 5 & 6: Logout, clean-up and check out.
$dbh->disconnect; # Bye, Bye !!! >=8+)

========== Code should be as above ==============