Transcript Using Perl and DBI/DBD With Informix Databases

Using Perl and DBI/DBD With
Informix Databases
Darryl Priest
Piper Rudnick LLP
[email protected]
Agenda
•
•
•
•
•
•
•
•
•
•
What is DBI & DBD::Informix?
Why Perl?
Why DBI/DBD::Informix?
Perl Basics
Database Connections
Static SQLs
Fetching Data
Other SQLs (Inserts, Deletes, etc.)
Putting It All Together
Supported, But Not Covered
Using Perl & DBI/DBD::Informix
2
Why Perl?
•
•
•
•
•
•
•
•
•
•
•
Easy To Start
Many Modules Available
Autovivification
Garbage Collection
Text Manipulation & Regular Expressions
Portability
Easy Access And Interaction With System Commands
Hashes
CGI
Speed
Code Reusability Using Modules
Using Perl & DBI/DBD::Informix
3
Why DBI/DBD::Informix?
•
•
•
•
•
Very well tested
Data Fetch Method Choices
IBM/Informix Support
Portability
Database Connections
Using Perl & DBI/DBD::Informix
4
Perl Basics
•
•
•
•
•
•
•
#!/usr/bin/perl -w
Variable Types (scalars, arrays, hashes, references)
use DBI;
use strict;
Variable Scope
TMTOWTDI
q# and qq#
Using Perl & DBI/DBD::Informix
5
DBI Generalizations
• Database connections are referred to as database handles
usually named $dbh, etc.
• Select SQLs usually follow the pattern
prepare,
execute, fetch, fetch, fetch …
execute, fetch, fetch, fetch …
• Non-select SQLs usually follow the pattern
prepare,
execute,
execute,
Using Perl & DBI/DBD::Informix
6
Database Connections
$dbh = DBI->connect($data_source, $username, $auth, \%attr);
$dbh = DBI->connect(“DBI:Informix:$database");
$dbh = DBI->connect(“DBI:Informix:$database", '', '',
{ AutoCommit => 0, PrintError => 1 });
my $dbh = DBI->connect("DBI:Informix:MyDatabase")
or die "MyDatabase Database Open Error: $DBI::errstr\n";
$dbh->{ChopBlanks} = 1;
$dbh->{AutoCommit} = 1;
$dbh->{PrintError} = 1;
$dbh->{RaiseError} = 1;
my $ps_dbh = DBI->connect("DBI:Informix:hrdb\@remote_tcp")
or die "PeopleSoft Database Open Error: $DBI::errstr\n";
$dbh->disconnect();
Using Perl & DBI/DBD::Informix
7
Static SQLs
$el_dbh->do("set isolation to dirty read;");
$el_dbh->do("set lock mode to wait;");
$sql = qq#create temp table temp_teamleader
(tkinit
char(5),
teamleader
char(5)
) with no log in tempdbs;#;
$el_dbh->do($sql);
$sql = qq#insert into temp_teamleader(tkinit, teamleader)
select udjoin, udvalue
from udf
where udf.udtype = "TK" and udf.udfindex = 55;#;
my $ins_teamleader_sth = $el_dbh->prepare($sql);
$ins_teamleader_sth->execute();
$el_dbh->do("create index teamldr_idx1 on temp_teamleader(tkinit);");
$el_dbh->do("update statistics high for table temp_teamleader;");
Using Perl & DBI/DBD::Informix
8
Fetching Data (Static SQL)
$sql = qq#select rttype, rtdesc from crltype order by 1;#;
my $get_party_type_sth = $el_dbh->prepare($sql);
$get_party_type_sth->execute();
Using Perl & DBI/DBD::Informix
9
Fetching Data with Placeholders
$sql = qq#select emplid, primary_contact, contact_name, relationship, phone
from ps_emergency_cntct
where emplid = ?
order by primary_contact desc, contact_name;#;
my $get_emerg_contact_sth = $ps_dbh->prepare_cached($sql);
$get_emerg_contact_sth->execute(“12345”);
• Or even better, using a scalar variable
my $InEmplid = “12345”;
$get_emerg_contact_sth->execute($InEmplid);
Using Perl & DBI/DBD::Informix
10
Processing Fetched Data
$sql = qq#select rttype, rtdesc from crltype order by 1;#;
my $get_party_type_sth = $el_dbh->prepare($sql);
$get_party_type_sth->execute();
my (@Row, $PartyTypes);
while ( @Row = $get_party_type_sth->fetchrow_array() ) {
$PartyTypes{$Row[0]} = $Row[1];
}
• Same thing using hash references
my ($Row, %PartyTypes);
while ( $Row = $get_party_type_sth->fetchrow_hashref() ) {
$PartyTypes{$Row->{rttype}} = $Row->{rtdesc};
}
Using Perl & DBI/DBD::Informix
11
Processing Fetched Data, continued
$sql = qq#select count(*), sum(lamount)
from ledger
where linvoice = ? and
lzero != "Y";#;
my $check_sth = $dbh->prepare($sql);
$check_sth->execute($InvoiceNumber);
($NotPaid, $Amount) = $check_sth->fetchrow_array();
if ( $NotPaid > 0 ) { print "Not Paid, $NotPaid Ledger Items"; }
else {
print "Paid, Moving ...";
}
Using Perl & DBI/DBD::Informix
12
Processing Fetched Data, continued
$sql = qq#select fieldname, fieldvalue, xlatlongname, xlatshortname
from xlattable x
where effdt = ((select max(effdt) from xlattable x1
where x1.fieldname = x.fieldname and
x1.fieldvalue = x.fieldvalue and
x1.effdt <= TODAY and
x1.language_cd = "ENG")) and
x.fieldname in ("COMP_FREQUENCY", "EMPL_TYPE", "REG_TEMP", "ACTION",
"MILITARY_STATUS", "ETHNIC_GROUP", "REFERRAL_SOURCE",
"FULL_PART_TIME", "OFFICER_CD", "FLSA_STATUS","SEX",
"MAR_STATUS", "EMPL_STATUS", "HIGHEST_EDUC_LVL",
"PHONE_TYPE") and
x.language_cd = "ENG"
order by 1,2;#;
my $get_xlat_sth = $ps_dbh->prepare($sql);
$get_xlat_sth->execute();
my ($XlatRow);
while ($XlatRow = $get_xlat_sth->fetchrow_hashref()) {
$Xlat{ $XlatRow->{fieldname} }
{ $XlatRow->{fieldvalue} } = { longname => $XlatRow->{xlatlongname},
shortname => $XlatRow->{xlatshortname} };
}
Using Perl & DBI/DBD::Informix
13
Processing Fetched Data, continued
• Previous example loads the %Xlat hash with values such as:
–
–
–
–
–
–
$Xlat{MAR_STATUS}->{A}->{longname} = “Head of Household”
$Xlat{MAR_STATUS}->{A}->{shortname} = “Hd Hsehld”
$Xlat{MAR_STATUS}->{M}->{longname} = “Married”;
$Xlat{MAR_STATUS}->{M}->{shortname} = “Married”;
$Xlat{SEX}->{F}->{longname} = “Female”;
$Xlat{SEX}->{M}->{shortname} = “Male”;
• Hash values are referenced with:
–
–
$Xlat{SEX}->{ $Active->{sex} }->{shortname}
$Xlat{MAR_STATUS}->{ $Active->{mar_status} }->{longname}
Using Perl & DBI/DBD::Informix
14
Binding Columns To Fetch Data
$sql = qq#select pcode, pdesc
from praccode
where pdesc is not null
order by 1;#;
my $get_praccodes_sth = $el_dbh->prepare($sql);
$get_praccodes_sth->execute();
my ($b_pcode, $b_pdesc);
$get_praccodes_sth->bind_columns(undef, \$b_pcode, \$b_pdesc);
while ( $get_praccodes_sth->fetch ) {
$PracCodes{$b_pcode} = $b_pdesc;
}
Using Perl & DBI/DBD::Informix
15
Binding Columns Continued
$sql = qq#select cmatter, to_char(cdisbdt, '%m/%d/%Y') cdisbdt, cbillamt
from cost
where cmatter is not null;#;
my $get_cost_sth = $el_dbh->prepare($sql);
my (%CostRow);
$get_cost_sth->bind_columns(undef,
\$CostRow{cmatter},
\$CostRow{cdisbdt},
\$CostRow{cbillamt});
while ( $get_cost_sth->fetch() ) {
… Do Something With %CostRow Hash Values …
}
Alternate syntax
$sth->bind_col($col_num, \$col_variable);
$sth->bind_columns(@list_of_refs_to_vars_to_bind);
Using Perl & DBI/DBD::Informix
16
Preparing & Fetching Together
my $sql = qq#select emplid, name_first2last name from pm_employees_v#;
my $NamesRef = $dbh->selectall_hashref($sql, "emplid");
…….
while ( $PeopleRow = $get_people_with_subitem_sth->fetchrow_hashref() ) {
…………
if ( defined $NamesRef->{ $PeopleRow->{emplid} } ) {
print "- $NamesRef->{ $PeopleRow->{emplid} }{name} "; }
else {
print “- Unknown”;
}
}
Using Perl & DBI/DBD::Informix
17
Inserting Rows
• Declare The Insert Statement Handle
$sql = qq#insert into winoutstat(wouser, wouser1, woreport, wotitle, wofile,
wodate0, wotime0, wostat1, wopid)
values(?, ?, ?, ?, ?,
?, ?, ?, ?);#;
my $ins_win_sth = $el_dbh->prepare_cached($sql);
• Insert The Row
$ins_win_sth->execute($Logon, $Logon, "Reminders", $Title, $FileName,
$OutDate, $OutTime, "RUNNING", $$);
my @Errd = @{$ins_win_sth->{ix_sqlerrd}};
$Hold{woindex} = $Errd[1];
Alternate syntax
$Hold{woindex} = $ins_win_sth->{ix_sqlerrd}[1];
Using Perl & DBI/DBD::Informix
18
Deleting Data
• Declare The Delete Statement Handle
$sql = qq#delete from pm_reminders
where matter_num = ? and
location = ? and
run_date = TODAY and
run_by = ?;#;
my $del_remind_sth = $el_dbh->prepare($sql);
• Delete Row(s) Based On Passed Parameters
$del_remind_sth->execute($MatRow->{mmatter},
$Hold{location},
$ThisLogon);
Using Perl & DBI/DBD::Informix
19
Using DBI With CGI
sub show_elite_files {
print header(),
start_html(-title=>"User File Manager",
-style=>{'src'=>'/styles/inSite_Style.css'});
$sql = qq#select woindex, woreport, wotitle, wodate0, wotime0,
wodate1, wotime1, wodesc1
from winoutstat
where (wostat1 = "COMPLETE" or wostat2 = "COMPLETE") and
wouser = ?
order by wodate0 desc, wotime0;#;
my $get_files_sth = $el_dbh->prepare($sql);
$get_files_sth->execute($ThisLogon);
my ($FileRow, $ViewLink, $ShowDate, $Count);
$Count = 0;
while ( $FileRow = $get_files_sth->fetchrow_hashref() ) {
$ViewLink = a({-href=>“getfiles.cgi?Session=${InSession}&FileNum=$FileRow->{woindex}"}, "Archive");
$ShowDate = "$FileRow->{wodate0} $FileRow->{wotime0}";
if ( $FileRow->{wodate0} ne $FileRow->{wodate1} ) {
$ShowDate .= " - " . $FileRow->{wodate1} . " " . $FileRow->{wotime1};
}
elsif ( $FileRow->{wotime0} ne $FileRow->{wotime1} ) {
$ShowDate .= "-" . $FileRow->{wotime1};
}
Using Perl & DBI/DBD::Informix
20
Using DBI With CGI, continued
### If This Is The First File Printed, Print The Headers First
if ( $Count == 0 ) {
my $ThisName = get_user_name($ThisLogon);
print start_table({-width=>'100%%',
-border=>1,
-cellpadding=>'5'}),
$NewLine,
Tr ( th ({-colspan=>'5'}, h4("Elite Report Files For User $ThisName") ) ),
Tr ( th ( "&nbsp" ),
th ( h4("Report") ),
th ( h4("Title") ),
th ( h4("Report Date") ),
th ( h4("Report Description") )
);
}
### Print Information For This File
print Tr ( td ({-align=>'center'}, "$ViewLink"),
td ({-align=>'left'}, "$FileRow->{woreport}"),
td ({-align=>'left'}, "$FileRow->{wotitle}"),
td ({-align=>'center'}, "$ShowDate"),
td ({-align=>'left'}, "$FileRow->{wodesc1}")
);
$Count++;
}
Using Perl & DBI/DBD::Informix
21
Using DBI With CGI, continued
### If No File Rows Found Show Error & Back Button, Otherwise
### Print The End Of The Table
if ( $Count == 0 ) {
print br, br,
textfield(-name=>'ProcessMessage',
-size=>'80',
-style=>$ErrorStyle,
-maxlength=>'80',
-value=>"No Files Were Found In Your Elite File Manager!"),
br, br;
print_back();
return;
}
else { print end_table(); }
print end_html();
} ### End Of SubRoutine show_elite_files
Using Perl & DBI/DBD::Informix
22
Using DBI With CGI, continued
Using Perl & DBI/DBD::Informix
23
Defining Reusable Code
#!/usr/bin/perl
package MyLib;
use strict;
require Exporter;
use vars
qw($VERSION @ISA @EXPORT);
$VERSION = 0.01;
@ISA = qw(Exporter);
@EXPORT = qw(get_names);
sub get_names {
my ($UseDbh, $Emplid) = @_;
my (@RetVals);
my $sql = qq#select first_name, last_name from pm_employees_v where emplid_s = ?;#;
my $get_names_sth = $UseDbh->prepare_cached($sql);
$get_names_sth->execute($Emplid);
@RetVals = $get_names_sth->fetchrow_array();
return @RetVals;
}
1;
Using Perl & DBI/DBD::Informix
24
Using Your Module
#!/usr/bin/perl –w
use DBI;
use strict;
use lib q{/perl/modules/};
use MyLib;
…………
if ( defined $Emplid ) {
my (@RetNames) = MyLib::get_names($dbh, $Emplid);
if ( defined $RetNames[0] ) { $Name = $RetNames[0]; }
else { $Name = “Name Unknown”; }
}
Using Perl & DBI/DBD::Informix
25
Default Database Connection Module
sub default_db_connect {
my ($DB, $Server) = @_;
my ($dbh);
if ( defined $Server and length($Server) > 1 ) {
$dbh = DBI->connect("DBI:Informix:${DB}\@${Server}"); }
else {
$dbh = DBI->connect("DBI:Informix:${DB}", undef, undef,{ PrintError=>0, RaiseError=>0 });
if ( ! defined $dbh ) {
$Server = default_informix_tcp(); ### Change Informix Server Name s/_shm/_tcp/
$dbh = DBI->connect("DBI:Informix:${DB}\@${Server}");
}
}
if ( defined $dbh ) {
$dbh->{AutoCommit} = 1;
$dbh->{ChopBlanks} = 1;
$dbh->{PrintError} = 1;
$dbh->{RaiseError} = 1;
if ( $dbh->{ix_LoggedDatabase} )
{ $dbh->do("set lock mode to wait;"); }
if ( $dbh->{ix_ModeAnsiDatabase} ) { $dbh->do("set isolation to dirty read;"); }
return $dbh; }
else { die "$DB Database Open Error, Error: $DBI::errstr"; }
} ### End Of SubRoutine default_db_connect
Using Perl & DBI/DBD::Informix
26
Get Employee Data Example
#!/usr/bin/perl -w
$| =1;
use DBI;
use strict;
use Getopt::Std;
use lib q{/perl/modules/bin};
use Defaults;
my $Usage = qq#
Usage: empl_info.pl [ -c Columns -d Database ] -e Emplid -l Logon -n Name
-c Column Name Match To Be Reported
-d Database Server To Select Database Data From
-e Employee ID To Report
-l Employee Logon ID To Report
-n Employee Name To Report
#;
use vars qw($opt_c $opt_d $opt_e $opt_l $opt_n);
getopts('c:d:e:l:n:');
Using Perl & DBI/DBD::Informix
27
Get Employee Data Example, cont’d
### Get User Input, Make Sure To Get An Emplid, Name Or Logon
my (%In);
if ( defined $opt_c ) { $In{columns} = $opt_c; }
if ( defined $opt_d ) { $In{db} = "MyDatabase\@$opt_d"; }
else { $In{db} = "MyDatabase"; }
if ( defined $opt_e ) { $In{emplid} = $opt_e; }
if ( defined $opt_l ) {
$In{logon} = $opt_l;
$In{logon} =~ tr/A-Z/a-z/;
}
if ( defined $opt_n ) {
$In{name} = $opt_n;
if ( $In{name} !~ /\*/ ) { $In{name} = "*" . $In{name} . "*"; }
}
if ( ! exists $In{emplid} and ! exists $In{logon} and ! exists $In{name} ) {
die "\n$Usage\n\n";
}
### Connect To MyDatabase
my ($dbh);
if ( defined $opt_d ) { $dbh = default_db_connect("MyDatabase", $opt_d); }
else { $dbh = default_db_connect("MyDatabase"); }
Using Perl & DBI/DBD::Informix
28
Get Employee Data Example, cont’d
### Select Emplid & Name For Passed Emplid/Logon/Name Match
my $sql = qq#select emplid, name_first2last from empl_search where#;
my ($get_emplid_sth);
SWITCH: {
if ( exists $In{emplid} ) {
$sql .= qq# emplid = ?#;
$get_emplid_sth = $dbh->prepare($sql);
$get_emplid_sth->execute($In{emplid});
last SWITCH;
}
if ( exists $In{logon} ) {
$sql .= qq# lower(logon_id) matches ?#;
$get_emplid_sth = $dbh->prepare($sql);
$get_emplid_sth->execute($In{logon});
last SWITCH;
}
if ( exists $In{name} ) {
$sql .= qq# name_first2last matches ?#;
$get_emplid_sth = $dbh->prepare($sql);
$get_emplid_sth->execute($In{name});
last SWITCH;
}
}
Using Perl & DBI/DBD::Informix
29
Get Employee Data Example, cont’d
### Fetch All Employees Found For Passed Match
my $EmplidRef = $get_emplid_sth->fetchall_arrayref();
### If Only Employee Matches, Call Show Subroutine, Else
### Show List Of Matching Employees And Allow User To Select
### In A Loop From The List And Report
if ( @{$EmplidRef} > 0 ) {
if ( @{$EmplidRef} == 1 ) { list_info($EmplidRef->[0][0]); }
else {
show_list($EmplidRef);
my ($Choice);
while (<>) {
chomp;
if ( $_ =~ /[Xx]/ ) { last; }
$Choice = $_ - 1;
list_info($EmplidRef->[$Choice][0]);
show_list($EmplidRef);
}
} }
else {
print "\n\nNo Matches Found For Passed Criteria\n\n";
}
$dbh->disconnect();
Using Perl & DBI/DBD::Informix
30
Get Employee Data Example, cont’d
### SubRoutine: show_list
### This subroutine will list the passed list reference
### of employee ids and names.
sub show_list {
my ($ListRef) = @_;
my ($x, $y);
print "\n\n
Selected Employees\n";
print "
-------- ---------\n";
for ($x = 0; $x < @{$ListRef}; $x++) {
$y = $x + 1;
print " $y.) $ListRef->[$x][1]($ListRef->[$x][0])\n";
}
print "\nEnter Choice(or x to exit): ";
} ### End Of SubRoutine show_list
Using Perl & DBI/DBD::Informix
31
Get Employee Data Example, cont’d
###
###
###
sub
SubRoutine: list_info
This subroutine will list the employee information
from pm_employees_v for the passed emplid.
list_info {
my ($ThisEmplid) = @_;
### Select All Potential Data Columns For Passed Emplid
$sql = qq#select * from employees_v where emplid = ?#;
my $get_MyDatabase_sth = $dbh->prepare_cached($sql);
$get_MyDatabase_sth->execute($ThisEmplid);
my ($Row, $Var);
while ( $Row = $get_MyDatabase_sth->fetchrow_hashref() ) {
### Print "Header" Of Employee Information
print ">" x 78, "\n";
for $Var ( qw(emplid name_first2last location_desc long_jobtitle) ) {
printf(" %18s: %-50s\n", $Var, $Row->{$Var});
}
print "\n";
Using Perl & DBI/DBD::Informix
32
Get Employee Data Example, cont’d
### For Each Returned Column
for $Var ( sort keys %{$Row} ) {
if ( $Var =~ /_s$/ ) { next; }
### If User Selected Specific Columns To Report, Only
### Report The Selected Columns
if ( exists $In{columns} ) {
if ( $Var !~ /$In{columns}/ ) { next; }
}
### If This Column Contains Data, Report It
if ( defined $Row->{$Var} and length($Row->{$Var}) > 0 ) {
write;
}
}
print "<" x 78, "\n";
}
### Define Output Format For Employee Data
format STDOUT =
@>>>>>>>>>>>>>>>>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Var,
$Row->{$Var}
~~
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Row->{$Var}
.
} ### End Of SubRoutine list_info
Using Perl & DBI/DBD::Informix
33
Get Employee Data Example, cont’d
empl_info.pl -n Darryl -c "job|name"
Selected
-------1.) Darryl
2.) Darryl
Employees
--------Priest(xxx)
Someone Else(xxx)
Enter Choice(or x to exit): 1
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
emplid: xxx
name_first2last: Darryl Priest
location_desc: Baltimore Office
long_jobtitle: Analyst / Developer Lead
deptname: IT Application Services
first_name: Darryl
job_family: MIS
last_name: Priest
long_deptname: IT Application Services
long_jobtitle: Analyst / Developer Lead
name_first2last: Darryl Priest
name_last2first: Priest, Darryl
short_name: D. Priest
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selected
-------1.) Darryl
2.) Darryl
Employees
--------Priest(xxx)
Someone Else(xxx)
Enter Choice(or x to exit): x
Using Perl & DBI/DBD::Informix
34
Archive Data Example
#!/usr/local/bin/perl
$| =1;
use DBI;
use Getopt::Std;
use lib q{/perl/modules/bin};
use GenLib qw(commify_integer);
use vars qw($opt_a $opt_c $opt_d $opt_k $opt_o $opt_s $opt_t $opt_v $opt_w $opt_u $opt_x);
my $Usage = qq#
Usage:
$0 [ -d Database -t Table ]
[< -k File Split Column Key >]
[< -c Column -o Operator -v Threshold Value >]
[< -s Output Directory -a Append Existing Files >]
[< -w Where -u Save Deletes -x Experimental Delete >]
-d
-t
-k
-c
-o
-v
-a
-s
-w
-u
-x
Database Name
Database Table To Be Archived
Key Column Used To Split Output Files
Column Name To Key Archive Selection
Operator To Determine Which Data To Keep
Threshold Value For The Key Column
Append To Existing Output Files
Directory To Save The Archived Data
Optional Additional Where Clause
Save Deleted Rows In Unload Type Files
Experimental, Don't Actually Delete, Just Count
#;
Using Perl & DBI/DBD::Informix
35
Archive Data Example, cont’d
### Define Usage Variables And Get From Passed Options
my ($Append, $Column, $Database, $SplitKey, $Operator, $Table);
my ($Threshold, $Where, $Directory, $Delete, $Write);
getopts('ac:d:k:o:s:t:v:w:ux');
### Make Sure The Table And Database Are Passed
if ( defined $opt_d ) { $Database = $opt_d; }
else { print $Usage; exit; }
if ( defined $opt_t ) { $Table = $opt_t; }
else { print $Usage; exit; }
### Get Optional Where Clause
if ( defined $opt_w ) { $Where = $opt_w; }
### Get Optional Save Deletes Option
if ( defined $opt_u ) { $Write = 1; }
else { $Write = 0; }
### Get Output File Split Key
if ( defined $opt_k ) { $SplitKey = $opt_k; }
### If Column Selection Criteria Is Passed, Make Sure The
### Correct Pieces Have All Been Passed
if ( defined $opt_c ) { $Column = $opt_c; }
if ( defined $opt_o ) { $Operator = $opt_o; }
elsif ( defined $Column ) { $Operator = "="; }
Using Perl & DBI/DBD::Informix
36
Archive Data Example, cont’d
if ( defined $opt_v ) {
$Threshold = $opt_v;
### If The Threshold Has Non Digits, Quote It, Unless
### It's Already Been Quoted
if ( $Threshold =~ /\D/ ) {
if ( $Threshold !~ /[\"\']/ ) {
$Threshold = qq#"$Threshold"#;
}
}
}
### Get Optional Output Directory
if ( defined $opt_s ) {
$Directory = $opt_s;
$Write = 1;
}
else { $Directory = $Table; }
### Get Optional X Options, Doesn't Actually Delete Data
if ( defined $opt_x ) { $Delete = 0; }
else { $Delete = 1; }
### Get Append Option, If Exists, Otherwise Default To Not Append
if ( defined $opt_a ) {
$Append = 1;
$Write = 1;
}
else { $Append = 0; }
### Display Passed Options Back To User
print "\n\n", '>' x 60, "\n";
Using Perl & DBI/DBD::Informix
37
Archive Data Example, cont’d
print "Preparing To Archive Data From ${Database}:${Table} ...\n";
if ( $Write ) { print "Data Rows To Be Deleted Will Be Saved In Directory $Directory\n"; }
else { print "Deleted Data Rows Will Not Be Written To Files\n"; }
if ( $Append ) { print "Existing Output Files Will Be Appended To\n"; }
### Build SQL To Select Data Rows To Be Archived
my ($sql, $SC, $WC);
$SC = qq#select#;
if ( defined $SplitKey ) {
print "Output Files Will Be Split By Key $SplitKey\n";
$SC .= qq# $SplitKey,#;
}
$SC .= qq# rowid, * from $Table#;
if ( defined $Operator and defined $Threshold ) {
print "Limiting Data Selection By $Column $Operator $Threshold\n";
$WC = qq#$Column $Operator $Threshold#;
}
if ( defined $Where ) {
print "Further Restricted By: $Where\n";
if ( defined $WC ) { $WC .= qq# and#; }
$WC .= qq# $Where#;
}
if ( defined $WC ) { $sql = qq#$SC where $WC#; }
else { $sql = $SC; }
Using Perl & DBI/DBD::Informix
38
Archive Data Example, cont’d
print "\nSelect Data Rows With SQL:\n$sql\n";
if ( ! $Delete ) { print "\nOnly Unloading Data, No Rows Will Be Deleted!!!\n"; }
### Verify Input Selections, If Running Interactively
if ( -t STDIN and -t STDOUT ) {
print "\nPress Any Key To Continue Or Control-C To Cancel\n";
my $Continue = getc();
}
### Make Directory To Write The Archived Data Out To
if ( $Write ) {
if ( ! -d $Directory ) {
print "Creating Directory $Directory For Output Files At ", `date +'%D %r'`;
mkdir ($Directory, 0777)
or die "Error Creating Directory For Output $Directory, $!\n";
}
}
### Open The Select Connection To The Database
my $dbh = DBI->connect("DBI:Informix:$Database")
or die "$Database Database Open Error: $DBI::errstr\n";
$dbh->{ChopBlanks} = 1;
$dbh->{AutoCommit} = 1;
$dbh->{PrintError} = 1;
$dbh->{RaiseError} = 1;
### Set The Database Lock Mode
$dbh->do("set lock mode to wait 300");
Using Perl & DBI/DBD::Informix
39
Archive Data Example, cont’d
### Build Statement Handle To Select Rows To Be Deleted
my $select_sth = $dbh->prepare($sql);
$select_sth->execute();
### Get Current Row Count From The Table
$sql = qq#select count(*) from $Table#;
my $count_sth = $dbh->prepare($sql);
$count_sth->execute();
my ($OrigCount) = $count_sth->fetchrow_array();
print "\n\nBefore Deletions $Table Has ", commify_integer($OrigCount), " Rows\n";
### Get Current Max Rowid From The Table
$sql = qq#select max(rowid) from $Table#;
my ($OrigMaxRowId) = $dbh->selectrow_array($sql);
print "Max RowId In $Table Is ", commify_integer($OrigMaxRowId), " \n\n";
### Prepare Delete Handle, Deleting By Rowid
$sql = qq#delete from $Table where rowid = ?#;
my $del_sth = $dbh->prepare($sql);
### Process Rows To Be Deleted Writing To Key Driven Output
### Files And Save The Rowids To Delete Later
my (@DataRow, $KeyValue, $RowId, %Files, $FileHandle, $NewFile);
my $DelRows = 0;
while ( @DataRow = $select_sth->fetchrow_array() ) {
if ( $DelRows > 0 and ( $DelRows % 10000 ) == 0 ) {
print commify_integer($DelRows), " Rows Read For Delete At ", `date +'%D %r'`;
}
Using Perl & DBI/DBD::Informix
40
Archive Data Example, cont’d
### If Archiving Using A Column Get That Column From The Results, Otherwise Use
### Set To A Default Values, Also Get The Rowid From The Fetch Array
if ( defined $SplitKey ) { $KeyValue = shift(@DataRow); }
else { $KeyValue = "all"; }
$RowId = shift(@DataRow);
### If The Key Data Column Is Not Defined Skip The Row
if ( ! defined $KeyValue ) { next; }
### If This Key Has Not Been Processed Yet, Open A New
### Output File For This Key
if ( ! defined $Files{$KeyValue}{Key} ) {
$Files{$KeyValue}{Key} = $KeyValue;
$Files{$KeyValue}{FileName} = "${Directory}/${Table}_${KeyValue}.unl";
### If Deleted Rows Are To Be Written, Check For Existing
### Files, And Open The Appropriate File Handle
if ( $Write ) {
### If The File Already Exists & We're Not Appending
### Move The Old File To A .old File
if ( -f $Files{$KeyValue}{FileName} ) {
$NewFile = "$Files{$KeyValue}{FileName}.old";
if ( ! $Append ) { rename $Files{$KeyValue}{FileName}, $NewFile; }
}
### Open The New File
$Files{$KeyValue}{Handle} = $KeyValue;
open ($Files{$KeyValue}{Handle}, ">> $Files{$KeyValue}{FileName}")
or die "Error Opening $Files{$KeyValue}{FileName}, $!\n";
}
}
Using Perl & DBI/DBD::Informix
41
Archive Data Example, cont’d
### If Deletes Are Being Saved, Clean Up The Data & Write It To The Correct File
if ( $Write ) {
### Convert NULLs Into Empty Strings
map { $_ = "" unless defined $_ } @DataRow;
### Write This Row To The Appropriate File, If Deletes Are Being Saved
$FileHandle = $Files{$KeyValue}{Handle};
print $FileHandle join('|', @DataRow), "|\n";
}
$Files{$KeyValue}{Count}++;
### Actually Delete The Row
if ( $Delete ) { $del_sth->execute($RowId); }
$DelRows++;
}
print "\nProcessed ", commify_integer($DelRows), " Rows From $Table At ", `date +'%D %r'`;
### Close All Output Files
my ($x);
print "\n";
if ( $Write ) { print "Closing Output Files At ", `date +'%D %r'`; }
foreach $x ( sort keys %Files ) {
if ( $x ne "all" ) {
print "Found ", commify_integer($Files{$x}{Count}), " Rows For $SplitKey = $x\n";
}
if ( $Write ) {
$FileHandle = $Files{$x}{Handle};
close $FileHandle;
}
}
Using Perl & DBI/DBD::Informix
42
Archive Data Example, cont’d
### Recheck The Row Count From The Table
$count_sth->execute();
my ($NewCount) = $count_sth->fetchrow_array();
print "\nThe Table $Table Now Has ", commify_integer($NewCount), " Rows\n";
### Check For Rows With RowIds Greater Than The Max From When The Program Started
$sql = qq#select count(*) from $Table where rowid > $OrigMaxRowId#;
my ($NewRows) = $dbh->selectrow_array($sql);
print "Found ", commify_integer($NewRows), " With RowIds > ", commify_integer($OrigMaxRowId), "\n";
### Display Warnings If Row Count Or Row Id Checks Fail
if ( $Delete ) {
if ( ( $OrigCount - $DelRows != $NewCount ) or $NewRows > 0 ) {
print "\n\n", '!' x 60, "\n";
print "Potential Deletion Problems\n";
print "Table $Table Had ", commify_integer($OrigCount),
" Rows, ", commify_integer($DelRows),
" Were To Be Deleted, But Count Is ", commify_integer($NewCount), "\n";
print "Found ", commify_integer($NewRows),
" With RowIds > ", commify_integer($OrigMaxRowId), "\n";
print '!' x 60, "\n";
}
else {
print "Appears To Have Processed Correctly\n";
}
}
### Disconnect From Databases
$dbh->disconnect();
print "\n", '>' x 60, "\n";
print "Finished Archiving ${Database}:${Table} At ", `date +'%D %r'`;
Using Perl & DBI/DBD::Informix
43
Archive Data Example, cont’d
archive_data.pl -d mydb -t testtable
-k "year(date1)" -x -u
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Preparing To Archive Data From mydb:testtable ...
Data Rows To Be Deleted Will Be Saved In Directory testtable
Output Files Will Be Split By Key year(date1)
Select Data Rows With SQL:
select year(date1), rowid, * from testtable
Only Unloading Data, No Rows Will Be Deleted!!!
Press Any Key To Continue Or Control-C To Cancel
Creating Directory testtable For Output Files At 04/20/04 03:07:14 PM
Before Deletions testtable Has 6 Rows
Max RowId In testtable Is 262
Processed 6 Rows From testtable At 04/20/04 03:07:14 PM
Closing
Found 2
Found 2
Found 2
Output Files At 04/20/04 03:07:14 PM
Rows For year(date1) = 2000
Rows For year(date1) = 2001
Rows For year(date1) = 2002
The Table testtable Now Has 6 Rows
Found 0 With RowIds > 262
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Finished Archiving mydb:testtable At 04/20/04 03:07:14 PM
wc -l testtable/*
2 testtable/testtable_2000.unl
2 testtable/testtable_2001.unl
2 testtable/testtable_2002.unl
Using Perl & DBI/DBD::Informix
44
Archive Data Example, cont’d
archive_data.pl -d son_db -t precost -c pcdate -o '<' -v '"01/01/2002"' -w 'pcvalid = "P"‘
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Preparing To Archive Data From son_db:precost ...
Deleted Data Rows Will Not Be Written To Files
Limiting Data Selection By pcdate < "01/01/2002"
Further Restricted By: pcvalid = "P"
Select Data Rows With SQL:
select rowid, * from precost where pcdate < "01/01/2002" and pcvalid = "P"
Before Deletions precost Has 11,355,500 Rows
Max RowId In precost Is 206,197,776
10,000 Rows Read For Delete At
20,000 Rows Read For Delete At
………..
7,730,000 Rows Read For Delete
7,740,000 Rows Read For Delete
01/14/04 06:06:59 PM
01/14/04 06:07:24 PM
At 01/14/04 10:06:16 PM
At 01/14/04 10:07:47 PM
Processed 7,747,585 Rows From precost At 01/14/04 10:10:02 PM
The Table precost Now Has 3,607,915 Rows
Found 0 With RowIds > 206,197,776
Appears To Have Processed Correctly
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Finished Archiving son_db:precost At 01/14/04 10:10:02 PM
Using Perl & DBI/DBD::Informix
45
Archive Data Example, cont’d
archive_data.pl -d son_db -t fmsaudit -c audate -o '<' -v '01/01/2002‘
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Preparing To Archive Data From son_db:fmsaudit ...
Deleted Data Rows Will Not Be Written To Files
Limiting Data Selection By audate < "01/01/2002"
Select Data Rows With SQL:
select rowid, * from fmsaudit where audate < "01/01/2002"
Before Deletions fmsaudit Has 4,597,692 Rows
Max RowId In fmsaudit Is 93,006,083
10,000 Rows Read For Delete At
20,000 Rows Read For Delete At
………
2,930,000 Rows Read For Delete
2,940,000 Rows Read For Delete
01/12/04 05:28:51 PM
01/12/04 05:29:05 PM
At 01/12/04 06:22:47 PM
At 01/12/04 06:22:59 PM
Processed 2,943,968 Rows From fmsaudit At 01/12/04 06:23:03 PM
The Table fmsaudit Now Has 1,653,735 Rows
Found 11 With RowIds > 93,006,083
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Potential Deletion Problems
Table fmsaudit Had 4,597,692 Rows, 2,943,968 Were To Be Deleted, But Count Is 1,653,735
Found 11 With RowIds > 93,006,083
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Finished Archiving son_db:fmsaudit At 01/12/04 06:23:03 PM
Using Perl & DBI/DBD::Informix
46
Supported, But Not Covered In Detail
• Accessing The Informix SQLCA Values
–
–
–
–
–
$sqlcode
$sqlerrm
$sqlerrp
@sqlerrd
@sqlwarn
=
=
=
=
=
$sth->{ix_sqlcode};
$sth->{ix_sqlerrm};
$sth->{ix_sqlerrp};
@{$sth->{ix_sqlerrd}};
@{$sth->{ix_sqlwarn}};
• Transactions using $dbh->commit(); and $dbh->rollback();
• Do With Parameters
– $dbh->do($stmt, undef, @parameters);
– $dbh->do($stmt, undef, $param1, $param2);
• $dbh->quote($string)
• $sth->finish and undef $sth
• Blob fields
Using Perl & DBI/DBD::Informix
47
Supported, But Not Covered, continued
•
•
•
•
•
$sth attributes, NUM_OF_FIELDS, NAME, etc.
DBI->trace($level, $tracefile);
Fetch methods selectrow_array() & selectall_array()
$dbh->func()
Statement Handles For Update
$st1 = $dbh->prepare("SELECT * FROM SomeTable FOR UPDATE");
$wc = "WHERE CURRENT OF $st1->{CursorName}";
$st2 = $dbh->prepare("UPDATE SomeTable SET SomeColumn = ? $wc");
$st1->execute;
$row = $st1->fetch;
$st2->execute("New Value");
• $sth->rows();
Using Perl & DBI/DBD::Informix
48
Additional Information
•
•
•
•
•
dbi.perl.org/ - DBI Home Page
www.perl.com - Perl
www.perl.org
www.cpan.org/ - Comprehensive Perl Archive Network
www.activestate.com
• perldoc DBI – DBI Man Pages
• perldoc DBD::Informix – DBD::Informix Man Pages
• Programming Perl by Larry Wall, Tom Christiansen & Randal Schwartz
• Programming the Perl DBI, by Alligator Descartes and Tim Bunce
• Learning Perl by Randal Schwartz
Using Perl & DBI/DBD::Informix
49
Thanks!
• To the authors who brought us:
– Perl
• Larry Wall
– DBI
• Tim Bunce
• Alligator Descartes
– DBD::Informix
• Jonathan Leffler
Using Perl & DBI/DBD::Informix
50