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: