1 / 50

Using Perl and DBI/DBD With Informix Databases

Learn about using Perl with Informix databases through DBI/DBD, covering basics, database connections, SQL queries, data fetching, and processing.

kennethcollins
Download Presentation

Using Perl and DBI/DBD With Informix Databases

An Image/Link below is provided (as is) to download presentation Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript

  1. Using Perl and DBI/DBD With Informix Databases Darryl Priest Piper Rudnick LLP darryl.priest@piperrudnick.com

  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

  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

  4. Why DBI/DBD::Informix? • Very well tested • Data Fetch Method Choices • IBM/Informix Support • Portability • Database Connections

  5. Perl Basics • #!/usr/bin/perl -w • Variable Types (scalars, arrays, hashes, references) • use DBI; • use strict; • Variable Scope • TMTOWTDI • q# and qq#

  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,

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

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

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

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

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

  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 ..."; }

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

  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}

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

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

  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”; } }

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

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

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

  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++; }

  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

  23. Using DBI With CGI, continued

  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;

  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”; } }

  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

  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:');

  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"); }

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

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

  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

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

  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

  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

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

  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 = "="; }

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

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

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

  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'`; }

  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"; } }

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

  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'`;

  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

  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

  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

  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

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

  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

  50. Thanks! • To the authors who brought us: • Perl • Larry Wall • DBI • Tim Bunce • Alligator Descartes • DBD::Informix • Jonathan Leffler

More Related