Using Perl and DBI/DBD With Informix Databases

whooploafΛογισμικό & κατασκευή λογ/κού

13 Δεκ 2013 (πριν από 3 χρόνια και 7 μήνες)

124 εμφανίσεις

Using Perl and DBI/DBD With

Informix Databases

Darryl Priest

Piper Rudnick LLP

darryl.priest@piperrudnick.com

Using Perl & DBI/DBD::Informix



2

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



3

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



4

Why DBI/DBD::Informix?


Very well tested


Data Fetch Method Choices


IBM/Informix Support


Portability


Database Connection
s

Using Perl & DBI/DBD::Informix



5

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



6

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



7

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



8

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



9

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



10

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



11

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



12

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



13

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



14

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



15

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



16

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



17

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



18

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



19

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



20

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



21

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



22

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



23

Using DBI With CGI, continued

Using Perl & DBI/DBD::Informix



24

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



25

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



26

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



27

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



28

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



29

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



30

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



31

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



32

Get Employee Data Example, cont’d

### SubRoutine: list_info

### This subroutine will list the employee information

### from pm_employees_v for the passed emplid.

sub 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



33

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



34

Get Employee Data Example, cont’d

empl_info.pl
-
n Darryl
-
c "job|name"



Selected Employees


--------

---------


1.) Darryl Priest(xxx)


2.) Darryl 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 Employees


--------

---------


1.) Darryl Priest(xxx)


2.) Darryl Someone Else(xxx)


Enter Choice(or x to exit): x

Using Perl & DBI/DBD::Informix



35

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 Database Name


-
t Database Table To Be Archived


-
k Key Column Used To Split Output Files


-
c Column Name To Key Archive Selection


-
o Operator To Determine Which Data To Keep


-
v Threshold Value For The Key Column


-
a Append To Existing Output Files


-
s Directory To Save The Archived Data


-
w Optional Additional Where Clause


-
u Save Deleted Rows In Unload Type Files


-
x Experimental, Don't Actually Delete, Just Count


#;

Using Perl & DBI/DBD::Informix



36

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



37

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



38

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



39

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



40

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



41

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



42

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



43

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



44

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 Output Files At 04/20/04 03:07:14 PM

Found 2 Rows For year(date1) = 2000

Found 2 Rows For year(date1) = 2001

Found 2 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



45

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 01/14/04 06:06:59 PM

20,000 Rows Read For Delete At 01/14/04 06:07:24 PM

………..

7,730,000 Rows Read For Delete At 01/14/04 10:06:16 PM

7,740,000 Rows Read For Delete 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



46

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 01/12/04 05:28:51 PM

20,000 Rows Read For Delete At 01/12/04 05:29:05 PM

………

2,930,000 Rows Read For Delete At 01/12/04 06:22:47 PM

2,940,000 Rows Read For Delete 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



47

Supported, But Not Covered In Detail


Accessing The Informix SQLCA Values


$sqlcode = $sth
-
>{ix_sqlcode};


$sqlerrm = $sth
-
>{ix_sqlerrm};


$sqlerrp = $sth
-
>{ix_sqlerrp};


@sqlerrd = @{$sth
-
>{ix_sqlerrd}};


@sqlwarn = @{$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



48

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



49

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



50

Thanks!


To the authors who brought us:



Perl


Larry Wall



DBI


Tim Bunce


Alligator Descartes



DBD::Informix


Jonathan Leffler