File Coverage

blib/lib/Labyrinth/DBUtils.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Labyrinth::DBUtils;
2              
3 6     6   21504 use warnings;
  6         8  
  6         175  
4 6     6   21 use strict;
  6         7  
  6         150  
5              
6 6     6   19 use vars qw($VERSION $AUTOLOAD);
  6         7  
  6         319  
7             $VERSION = '5.31';
8              
9             =head1 NAME
10              
11             Labyrinth::DBUtils - Database Manager for Labyrinth
12              
13             =head1 SYNOPSIS
14              
15             use Labyrinth::DBUtils;
16              
17             my $dbi = Labyrinth::DBUtils->new({
18             driver => 'CSV',
19             file => '/var/www/mysite/db');
20             sub errors { print STDERR "Error: $_[0], sql=$_[1]\n" }
21              
22             my @arr = $dbi->GetQuery('array','getTables');
23             my @arr = $dbi->GetQuery('array','getTable',$bid);
24             my @arr = $dbi->GetQuery('hash','getOneRow',
25             {table=>'uds_build',field=>'bid'},$bid});
26              
27             my $id = $dbi->IDQuery('insertRow',$id,$name);
28             $dbi->DoQuery('deleteRow',$id);
29             $dbi->DoQuery('updateRow',{id=>$id,name=>$name});
30              
31             my $next = Iterator('array','getTables');
32             my $row = $next->(); # returns an array ref
33              
34             my $next = Iterator('hash','getTables');
35             my $row = $next->(); # returns a hash ref
36              
37             $value = $dbi->Quote($value);
38              
39             =head1 DESCRIPTION
40              
41             The DBUtils package is a further database interface layer, providing a
42             collection of control methods to initiate the database connection, handle
43             errors and a smooth handover from the program to the database drivers.
44              
45             Reads and handles the SQL from the phrasebook, passing the statement and any
46             additional parameters through to the DBI onject.
47              
48             =cut
49              
50             # -------------------------------------
51             # Library Modules
52              
53 6     6   8067 use DBI;
  6         80117  
  6         360  
54             #use DBD::mysql;
55              
56 6     6   376 use Labyrinth::Audit;
  6         8  
  6         861  
57 6     6   1952 use Labyrinth::Phrasebook;
  0            
  0            
58             use Labyrinth::Writer;
59              
60             # -------------------------------------
61             # Variables
62              
63             my %autosubs = map {$_ => 1} qw( driver database file host port user password );
64              
65             # -------------------------------------
66             # The Public Interface Subs
67              
68             =head2 CONSTRUCTOR
69              
70             =over 4
71              
72             =item new DBUtils({})
73              
74             The Constructor method. Can be called with an anonymous hash,
75             listing the values to be used to connect to and handle the database.
76              
77             Values in the hash can be
78              
79             logfile
80             phrasebook (*)
81             dictionary
82             driver (*)
83             database (+)
84             dbfile (+)
85             dbhost
86             dbport
87             dbuser
88             dbpass
89             autocommit
90              
91             (*) These entries MUST exist in the hash.
92             (+) At least ONE of these must exist in the hash, and depend upon the driver.
93              
94             Note that 'file' is for use with a flat file database, such as DBD::CSV.
95              
96             =back
97              
98             =cut
99              
100             sub new {
101             my ($self, $hash) = @_;
102             my ($log,$pb) = (undef,undef); # in case a log is not required
103              
104             my $logfile = $hash->{logfile}; # mandatory
105             my $phrasebook = $hash->{phrasebook}; # mandatory
106             my $dictionary = $hash->{dictionary} || 'PROCS'; # optional
107              
108             # check we've got our mandatory fields
109             Croak("$self needs a driver!") unless($hash->{driver});
110             Croak("$self needs a database/file!")
111             unless($hash->{database} || $hash->{file});
112             Croak("$self needs a phrasebook!") unless($phrasebook);
113              
114             # check files exist and we can access them correctly
115             Croak("$self cannot access phrasebook [$phrasebook]!")
116             unless($phrasebook && -r $phrasebook);
117              
118              
119             # initiate the phrasebook
120             $pb = Labyrinth::Phrasebook->new($phrasebook);
121             $pb->load($dictionary);
122              
123             # create an attributes hash
124             my $dbv = {
125             'driver' => $hash->{driver},
126             'database' => $hash->{database},
127             'file' => $hash->{dbfile},
128             'host' => $hash->{dbhost},
129             'port' => $hash->{dbport},
130             'user' => $hash->{dbuser},
131             'password' => $hash->{dbpass},
132             'log' => $log,
133             'pb' => $pb,
134             };
135              
136             $dbv->{autocommit} = $hash->{autocommit} if(defined $hash->{autocommit});
137              
138             # create the object
139             bless $dbv, $self;
140             return $dbv;
141             }
142              
143             =head2 PUBLIC INTERFACE METHODS
144              
145             =over 4
146              
147             =item GetQuery(type,key,)
148              
149             type - 'array' or 'hash'
150             key - hash key to sql in phrasebook
151             - optional additional values to be inserted into SQL placeholders
152              
153             The function performs a SELECT statement, which returns either a list of lists,
154             or a list of hashes. The difference being that for each record, the field
155             values are listed in the order they are returned, or via the table column
156             name in a hash.
157              
158             The first entry in can be an anonymous hash, containing the placeholder
159             values to be interpolated by Class::Phrasebook.
160              
161             Note that if the key is not found in the phrasebook, the function returns
162             with undef.
163              
164             =cut
165              
166             sub GetQuery {
167             my ($dbv,$type,$key,@args) = @_;
168             my ($hash,$sql);
169              
170             # retrieve the sql from the phrasebook,
171             # inserting placeholders (if required)
172             $hash = shift @args if(ref($args[0]) eq "HASH");
173             eval { $sql = $dbv->{pb}->get($key,$hash); };
174            
175             LogDebug("key=[$key], sql=[$sql], args[".join(",",map{$_ || ''} @args)."], err=$@");
176             return () unless($sql);
177              
178             # if the object doesnt contain a reference to a dbh object
179             # then we need to connect to the database
180             $dbv = &_db_connect($dbv) if not $dbv->{dbh};
181              
182             # prepare the sql statement for executing
183             my $sth = $dbv->{dbh}->prepare($sql);
184             unless($sth) {
185             LogError("err=".$dbv->{dbh}->errstr.", key=[$key], sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
186             return ();
187             }
188              
189             # execute the SQL using any values sent to the function
190             # to be placed in the sql
191             if(!$sth->execute(@args)) {
192             LogError("err=".$sth->errstr.", key=[$key], sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
193             return ();
194             }
195              
196             my @result;
197             # grab the data in the right way
198             if ( $type eq 'array' ) {
199             while ( my $row = $sth->fetchrow_arrayref() ) {
200             push @result, [@{$row}];
201             }
202             } else {
203             while ( my $row = $sth->fetchrow_hashref() ) {
204             push @result, $row;
205             }
206             }
207              
208             # finish with our statement handle
209             $sth->finish;
210             # return the found datastructure
211             return @result;
212             }
213              
214             =item Iterator(type,key,)
215              
216             type - 'array' or 'hash'
217             key - hash key to sql in phrasebook
218             - optional additional values to be inserted into SQL placeholders
219              
220             The function performs a SELECT statement, which returns a subroutine reference
221             which can then be used to obtain either a list of lists, or a list of hashes.
222             The difference being that for each record, the field values are listed in the
223             order they are returned, or via the table column name in a hash.
224              
225             The first entry in can be an anonymous hash, containing the placeholder
226             values to be interpolated by Class::Phrasebook.
227              
228             Note that if the key is not found in the phrasebook, the function returns
229             with undef.
230              
231             =cut
232              
233             sub Iterator {
234             my ($dbv,$type,$key,@args) = @_;
235             my ($hash,$sql);
236              
237             # retrieve the sql from the phrasebook,
238             # inserting placeholders (if required)
239             $hash = shift @args if(ref($args[0]) eq "HASH");
240             eval { $sql = $dbv->{pb}->get($key,$hash); };
241              
242             LogDebug("key=[$key], sql=[$sql], args[".join(",",map{$_ || ''} @args)."], err=$@");
243             return unless($sql);
244              
245             # if the object doesnt contain a reference to a dbh object
246             # then we need to connect to the database
247             $dbv = &_db_connect($dbv) if not $dbv->{dbh};
248              
249             # prepare the sql statement for executing
250             my $sth = $dbv->{dbh}->prepare($sql);
251             unless($sth) {
252             LogError("err=".$dbv->{dbh}->errstr.", sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
253             return;
254             }
255              
256             # execute the SQL using any values sent to the function
257             # to be placed in the sql
258             if(!$sth->execute(@args)) {
259             LogError("err=".$sth->errstr.", sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
260             return;
261             }
262              
263             # grab the data in the right way
264             if ( $type eq 'array' ) {
265             return sub {
266             if ( my $row = $sth->fetchrow_arrayref() ) { return $row; }
267             else { $sth->finish; return; }
268             }
269             } else {
270             return sub {
271             if ( my $row = $sth->fetchrow_hashref() ) { return $row; }
272             else { $sth->finish; return; }
273             }
274             }
275             }
276              
277             =item DoQuery(key,)
278              
279             key - hash key to sql in phrasebook
280             - optional additional values to be inserted into SQL placeholders
281              
282             The function performs an SQL statement. If performing an INSERT statement that
283             returns an record id, this is returned to the calling function.
284              
285             The first entry in can be an anonymous hash, containing the placeholder
286             values to be interpolated by Class::Phrasebook.
287              
288             Note that if the key is not found in the phrasebook, the function returns
289             with undef.
290              
291             =cut
292              
293             sub DoQuery {
294             my ($dbv,$key,@args) = @_;
295             my ($hash,$sql);
296              
297             # retrieve the sql from the phrasebook,
298             # inserting placeholders (if required)
299             $hash = shift @args if(ref($args[0]) eq "HASH");
300             eval { $sql = $dbv->{pb}->get($key,$hash); };
301              
302             LogDebug("key=[$key], sql=[$sql], args[".join(",",map{$_ || ''} @args)."], err=$@");
303             return unless($sql);
304              
305             $dbv->_doQuery($sql,0,@args);
306             }
307              
308             =item IDQuery(key,)
309              
310             key - hash key to sql in phrasebook
311             - optional additional values to be inserted into SQL placeholders
312              
313             The function performs an SQL statement. If performing an INSERT statement that
314             returns an record id, this is returned to the calling function.
315              
316             The first entry in can be an anonymous hash, containing the placeholder
317             values to be interpolated by Class::Phrasebook.
318              
319             Note that if the key is not found in the phrasebook, the function returns
320             with undef.
321              
322             =cut
323              
324             sub IDQuery {
325             my ($dbv,$key,@args) = @_;
326             my ($hash,$sql);
327              
328             # retrieve the sql from the phrasebook,
329             # inserting placeholders (if required)
330             $hash = shift @args if(ref($args[0]) eq "HASH");
331             eval { $sql = $dbv->{pb}->get($key,$hash); };
332              
333             LogDebug("key=[$key], sql=[$sql], args[".join(",",map{$_ || ''} @args)."], err=$@");
334             return unless($sql);
335              
336             return $dbv->_doQuery($sql,1,@args);
337             }
338              
339             =item DoSQL(sql,)
340              
341             sql - SQL statement
342             - optional additional values to be inserted into SQL placeholders
343              
344             =cut
345              
346             sub DoSQL {
347             my ($dbv,$sql,@args) = @_;
348             return unless($sql);
349              
350             $dbv->_doQuery($sql,0,@args);
351             }
352              
353             # _doQuery(key,idrequired,)
354             #
355             # key - hash key to sql in phrasebook
356             # idrequired - true if an ID value is required on return
357             # - optional additional values to be inserted into SQL placeholders
358             #
359             #The function performs an SQL statement. If performing an INSERT statement that
360             #returns an record id, this is returned to the calling function.
361             #
362             #The first entry in can be an anonymous hash, containing the placeholder
363             #values to be interpolated by Class::Phrasebook.
364             #
365             #Note that if the key is not found in the phrasebook, the function returns
366             #with undef.
367             #
368              
369             sub _doQuery {
370             my ($dbv,$sql,$idrequired,@args) = @_;
371             my $rowid = undef;
372              
373             LogDebug("sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
374             return $rowid unless($sql);
375              
376             # if the object doesnt contain a refrence to a dbh object
377             # then we need to connect to the database
378             $dbv = &_db_connect($dbv) if not $dbv->{dbh};
379              
380             if($idrequired) {
381             # prepare the sql statement for executing
382             my $sth = $dbv->{dbh}->prepare($sql);
383             unless($sth) {
384             LogError("err=".$dbv->{dbh}->errstr.", sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
385             return;
386             }
387              
388             # execute the SQL using any values sent to the function
389             # to be placed in the sql
390             if(!$sth->execute(@args)) {
391             LogError("err=".$sth->errstr.", sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
392             return;
393             }
394              
395             if($dbv->{driver} =~ /mysql/i) {
396             $rowid = $dbv->{dbh}->{mysql_insertid};
397             } else {
398             my $row;
399             $rowid = $row->[0] if( $row = $sth->fetchrow_arrayref() );
400             }
401              
402             } else {
403             eval { $rowid = $dbv->{dbh}->do($sql, undef, @args) };
404             if ( $@ ) {
405             LogError("err=".$dbv->{dbh}->errstr.", sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
406             return -1;
407             }
408              
409             $rowid ||= 1; # technically this should be the number of succesful rows
410             }
411              
412              
413             ## Return the rowid we just used
414             return $rowid;
415             }
416              
417             =item Quote(string)
418              
419             string - string to be quoted
420              
421             The function performs a DBI quote operation, which will quote a string
422             according to the SQL rules.
423              
424             =cut
425              
426             sub Quote {
427             my $dbv = shift;
428             return unless($_[0]);
429              
430             # Cant quote with DBD::CSV
431             return $_[0] if($dbv->{driver} =~ /csv/i);
432              
433             # if the object doesnt contain a refrence to a dbh object
434             # then we need to connect to the database
435             $dbv = &_db_connect($dbv) if not $dbv->{dbh};
436              
437             $dbv->{dbh}->quote($_[0]);
438             }
439              
440             # -------------------------------------
441             # The Get & Set Methods Interface Subs
442              
443             =item Get & Set Methods
444              
445             The following accessor methods are available:
446              
447             driver
448             database
449             file
450             host
451             port
452             user
453             password
454              
455             All functions can be called to return the current value of the associated
456             object variable, or be called with a parameter to set a new value for the
457             object variable.
458              
459             (*) Setting these methods will take action immediately. All other access
460             methods require a new object to be created, before they can be used.
461              
462             Examples:
463              
464             my $database = db_database();
465             db_database('another');
466              
467             =cut
468              
469             sub AUTOLOAD {
470             no strict 'refs';
471             my $name = $AUTOLOAD;
472             $name =~ s/^.*:://;
473             die "Unknown sub $AUTOLOAD\n" unless($autosubs{$name});
474              
475             *$name = sub { my $dbv=shift; @_ ? $dbv->{$name}=shift : $dbv->{$name} };
476             goto &$name;
477             }
478              
479             # -------------------------------------
480             # The Private Subs
481             # These modules should not have to be called from outside this module
482              
483             sub _db_connect {
484             my $dbv = shift;
485              
486             my $dsn = 'dbi:' . $dbv->{driver};
487             my $ac = defined $dbv->{autocommit} ? $dbv->{autocommit} : 1;
488              
489             if($dbv->{driver} =~ /ODBC/) {
490             # all the info is in the Data Source repository
491              
492             } elsif($dbv->{driver} =~ /SQLite/) {
493             $dsn .= ':dbname=' . $dbv->{database} if $dbv->{database};
494             $dsn .= ';host=' . $dbv->{host} if $dbv->{host};
495             $dsn .= ';port=' . $dbv->{port} if $dbv->{port};
496              
497             } else {
498             $dsn .= ':f_dir=' . $dbv->{file} if $dbv->{file};
499             $dsn .= ':database='. $dbv->{database} if $dbv->{database};
500             $dsn .= ';host=' . $dbv->{host} if $dbv->{host};
501             $dsn .= ';port=' . $dbv->{port} if $dbv->{port};
502             }
503              
504             # LogDebug("dsn=[$dsn] user[$dbv->{user}] password[$dbv->{password}]" );
505              
506             eval {
507             $dbv->{dbh} = DBI->connect($dsn, $dbv->{user}, $dbv->{password},
508             { RaiseError => 1, AutoCommit => $ac });
509             };
510              
511             Croak("Cannot connect to DB [$dsn]: $@") if($@);
512             return $dbv;
513             }
514              
515             sub DESTROY {
516             my $dbv = shift;
517             # $dbv->{dbh}->commit if defined $dbv->{dbh};
518             $dbv->{dbh}->disconnect if defined $dbv->{dbh};
519             }
520              
521             1;
522              
523             __END__