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 ( " " ), ); 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

### 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 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 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 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 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 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 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 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 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 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 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 46

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