1: =head1 NAME
   2: 
   3: DbiFunc.pm -- provides basic DBI/SQL operations
   4: 
   5: =head1 SYNOPSIS
   6: 
   7:   use DbiFunc;
   8: 
   9:   my $db = DbiFunc->new( "account_name" );
  10: 
  11:   $cell_scalar = $db->queryCell( "select ..." );
  12:                = $db->queryCell( $qHandle, $param[, $param2...] );
  13: 
  14:   $row_ary_ref = $db->queryRow( "select ..." );
  15:                = $db->queryRow( $qHandle, $param[, $param2...] );
  16: 
  17:   $col_ary_ref = $db->queryColumn( "select ..." );
  18:                = $db->queryColumn( $qHandle, $param[, $param2...] );
  19: 
  20:   $ary_ary_ref = $db->queryGrid( "select ..." );
  21:                = $db->queryGrid( $qHandle, $param[, $param2...] );
  22: 
  23:   $N_rows_done = $db->sqlOnce( "update or insert statement" );
  24: 
  25:   $qHandle = $db->sqlPrep( "select statement with 1 or more ?" );
  26:   $xHandle = $db->sqlPrep( "update/insert statement with 1+ ?" );
  27: 
  28:   $N_rows_done = $db->sqlApply( $xHandle, $param[, $param2...] );
  29: 
  30:   &sqlDone( $anyHandle );
  31: 
  32: 
  33: =head1 DESCRIPTION
  34: 
  35: The DbiFunc module is intended to make it easy to manipulate the
  36: contents of RDBMS tables using perl scripts -- assuming that the perl
  37: programmer is reasonably skilled at using SQL.
  38: 
  39: The names of the methods should be self-explanatory, and some examples
  40: are provided below to clarify proper usage.  The issues that require
  41: extra care by the programmer are:
  42: 
  43: - Make sure that an SQL statement string or handle is
  44:   appropriate to the particular method you pass it to.
  45: 
  46: - Make sure, when passing an SQL statement handle to
  47:   sqlApply or a query method, that you pass the correct
  48:   number of parameters, in the correct order, to fit
  49:   the statement that defined the handle.
  50: 
  51: The "sqlOnce" method, in addition to performing "update" and "insert"
  52: operations, is good for administrative functions as well, such as
  53: "create table ...", "alter table ...", "drop table ...", etc. -- use
  54: these with caution!
  55: 
  56: 
  57: =head1 EXAMPLES
  58: 
  59:   my $db = DbiFunc->new( "my_account" );
  60: 
  61:   # some simple queries:
  62: 
  63:   my $nrows = $db->queryCell("select count( key_fld ) from my_table");
  64: 
  65:   print "my_table has $nrows entries\n";
  66: 
  67:   my $keyref = $db->queryColumn("select key_fld from my_table");
  68: 
  69:   print "list of key_fld entries in my_table:\n";
  70:   print join( "\n", @$keyref ), "\n";
  71: 
  72:   my $qry = "select * from my_table where key_fld = \'$$keyref[10]\'";
  73:   my $rowref = $db->queryRow( $qry );
  74: 
  75:   $db->sqlOnce( "delete from my_table where keyfld = \'$$keyref[10]\'";
  76: 
  77:   print "Former contents the 11th row in my_table (just deleted):\n";
  78:   print join( " ", @$rowref ), "\n";
  79: 
  80:   my $gridref = $db->queryGrid("select name,date from my_table");
  81: 
  82:   print "list of (remaining) names and dates from my_table:\n"
  83:   foreach my $row ( @$gridref )
  84:   {
  85:     my ($name,$date) = @$row;
  86:     print "Name = $name, Date = $date\n";
  87:   }
  88: 
  89:   # some parameterized operations:
  90: 
  91:   my $qry = $db->sqlPrep("select age from my_table where name = ?");
  92:   my $upd = $db->sqlPrep("update my_table set age = ? where name = ?");
  93:   my $ins = $db->sqlPrep("insert into my_table (name,age) values (?,?)");
  94: 
  95:   foreach my $person ( "Barry", "Bill", "Bob" )
  96:   {
  97:     $age = $db->sqlApply( $qry, $person );
  98:     if ( $age ) 
  99:     {                               # person's already in my_table
 100:       $db->sqlApply( $upd, $age+1, $person );
 101:     }
 102:     else
 103:     {
 104:       $db->sqlApply( $ins, $person, 21 ); # "adults only"
 105:     }
 106:   }
 107: 
 108:   $db->sqlDone( $qry );
 109:   $db->sqlDone( $upd );
 110:   $db->sqlDone( $ins );
 111: 
 112: =head1 CAVEAT and discussion
 113: 
 114: Some details in the following code are specific to Oracle, and no
 115: attempt has been made by the original author to adapt to other brands
 116: of RDBMS.  Doing so should be a simple exercise for those who have
 117: already used DBI in their particular environs.
 118: 
 119: A nice feature of this DBI-wrapper module is that it allows all your
 120: site-specific RDBMS environment stuff, including account names and
 121: passwords, to be written just once -- into this module -- rather than
 122: being repeated in every perl script that uses a database (so guess how
 123: much perl code you need to fix the next time you have to change
 124: passwords or migrate to a new RDBMS release).  Plus, it is nice being
 125: able to call just one method to execute an SQL statement and get back
 126: the results.
 127: 
 128: =head1 AUTHORS
 129: 
 130: David Graff <graff@ldc.upenn.edu>
 131: Jonathan Wright <jdwright@ldc.upenn.edu>
 132: 
 133: =cut
 134: 
 135: package DbiFunc;
 136: 
 137: @ISA = qw(DBI::db);
 138: 
 139: use DBI;
 140: use Carp;
 141: use strict;
 142: 
 143: # Put essential environment stuff here, as required by your RDBMS
 144: # e.g. for a given (mythical) installation of Oracle:
 145: 
 146: $ENV{ORACLE_SID} = "MYSID";
 147: $ENV{ORACLE_BASE} = "/my/oracle/base";
 148: $ENV{ORACLE_HOME} = "$ENV{ORACLE_BASE}/product/8.1.5";
 149: $ENV{PATH} .= ":$ENV{ORACLE_HOME}/bin";
 150: my $ORA_DSN = 'dbi:Oracle:MYSID.whatsadsn_anyway';
 151: 
 152: 1;
 153: 
 154: sub new {
 155:     my ($class,$account,$attr) = @_;
 156:     my %passwd = ( "some_account" => "some_password",
 157:                    "other_account" => "other_password",
 158:                    );
 159:     $attr = { PrintError => 0, RaiseError => 1 } 
 160:         unless ref $attr eq 'HASH';
 161:     my $dbh;
 162:     if ( exists $passwd{$account} ) {
 163:         $dbh = DBI->connect($ORA_DSN,$account,$passwd{$account},$attr) ||
 164:             croak "Oracle connection failed: $DBI::errstr";
 165:     } else {
 166:         croak "\n$account is not a known account\n";
 167:     }
 168:     return bless $dbh, 'DbiFunc';
 169: }
 170: 
 171: sub DESTROY {
 172:     my ($dbh) = @_;
 173:     $dbh->disconnect if ( defined( $dbh ));
 174: }
 175: 
 176: sub queryCell
 177: {
 178:     my ($dbh,$sql,@params) = @_;
 179:     my $rowref;
 180:     if ( ref( $sql ) =~ /^DBI/ ) {
 181:         $sql->execute( @params );
 182:         $rowref = $sql->fetchrow_arrayref;
 183:     } elsif ( $sql !~ /^\s*select / ) {
 184:         carp "queryCell called without a select statement\n";
 185:         return undef;
 186:     } else {
 187:         my $sth = $dbh->prepare( $sql );
 188:         $sth->execute;
 189:         $rowref = $sth->fetchrow_arrayref;
 190:         $sth->finish;
 191:     }
 192:     return $rowref->[0];
 193: }
 194: 
 195: sub queryRow
 196: {
 197:     my ($dbh,$sql,@params) = @_;
 198:     my $rowref;
 199:     if ( ref( $sql ) =~ /^DBI/ ) {
 200:         $sql->execute( @params );
 201:         $rowref = $sql->fetchrow_arrayref;
 202:     } elsif ( $sql !~ /^\s*select / ) {
 203:         carp "queryRow called without a select statement\n";
 204:         return undef;
 205:     } else {
 206:         my $sth = $dbh->prepare( $sql );
 207:         $sth->execute;
 208:         $rowref = $sth->fetchrow_arrayref;
 209:         $sth->finish;
 210:     }
 211:     return $rowref;
 212: }
 213: 
 214: sub queryColumn
 215: {
 216:     my ($dbh,$sql,@params) = @_;
 217:     my $rowref;
 218:     if ( ref( $sql ) =~ /^DBI/ ) {
 219:         $sql->execute( @params );
 220:         $rowref = $sql->fetchall_arrayref;
 221:     } elsif ( $sql !~ /^\s*select / ) {
 222:         carp "queryColumn called without a select statement\n";
 223:         return undef;
 224:     } else {
 225:         my $sth = $dbh->prepare( $sql );
 226:         $sth->execute( @params );
 227:         $rowref = $sth->fetchall_arrayref;
 228:         $sth->finish;
 229:     }
 230:     my @col = ();
 231:     foreach my $r ( @$rowref ) {
 232:         push( @col, $r->[0] );
 233:     }
 234:     return \@col;
 235: }
 236: 
 237: sub queryGrid
 238: {
 239:     my ($dbh,$sql,@params) = @_;
 240:     my $rowref;
 241:     if ( ref( $sql ) =~ /^DBI/ ) {
 242:         $sql->execute( @params );
 243:         $rowref = $sql->fetchall_arrayref;
 244:     } elsif ( $sql !~ /^\s*select / ) {
 245:         carp "queryGrid called without a select statement\n";
 246:         return undef;
 247:     } else {
 248:         my $sth = $dbh->prepare( $sql );
 249:         $sth->execute;
 250:         $rowref = $sth->fetchall_arrayref;
 251:         $sth->finish;
 252:     }
 253:     return $rowref;
 254: }
 255: 
 256: sub sqlOnce
 257: {
 258:     my ($dbh,$sql) = @_;
 259:     my $ret = $dbh->do( $sql );
 260:     return $ret;
 261: }
 262: 
 263: sub sqlPrep
 264: {
 265:     my ($dbh,$sql) = @_;
 266:     my $this_sth = $dbh->prepare( $sql );
 267:     return $this_sth;
 268: }
 269: 
 270: sub sqlApply
 271: {
 272:     my ($dbh,$this_sth, @params) = @_;
 273:     my $ret = $this_sth->execute( @params );
 274:     return $ret;
 275: }
 276: 
 277: sub sqlDone
 278: {
 279:     my ($dbh,$this_sth) = @_;
 280:     $this_sth->finish;
 281: }
 282: 
 283: 1;
 284: