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