/[cvs]/nfo/perl/libs/Data/Storage/Handler/DBI.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Data/Storage/Handler/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (hide annotations)
Fri Apr 11 01:17:18 2003 UTC (21 years, 3 months ago) by joko
Branch: MAIN
Changes since 1.15: +21 -5 lines
sendQuery:
+ introduced crud action 'DELETE'
+ some pre-flight checks

1 cvsjoko 1.1 #################################
2     #
3 joko 1.16 # $Id: DBI.pm,v 1.15 2003/04/09 07:53:33 joko Exp $
4 joko 1.2 #
5     # $Log: DBI.pm,v $
6 joko 1.16 # Revision 1.15 2003/04/09 07:53:33 joko
7     # minor namespace update
8     #
9 joko 1.15 # Revision 1.14 2003/04/09 06:06:04 joko
10     # sendQuery now is capable of doing 'SELECT'- or 'INSERT'-queries
11     #
12 joko 1.14 # Revision 1.13 2003/04/08 23:06:45 joko
13     # renamed core database helper functions
14     #
15 joko 1.13 # Revision 1.12 2003/01/30 22:28:21 joko
16     # + implemented new concrete methods
17     #
18 joko 1.12 # Revision 1.11 2002/12/19 16:31:05 joko
19     # + sub dropDb
20     # + sub rebuildDb
21     #
22 joko 1.11 # Revision 1.10 2002/12/15 02:02:22 joko
23     # + fixed logging-message
24     #
25 joko 1.10 # Revision 1.9 2002/12/05 07:58:20 joko
26     # + now using Tie::SecureHash as a base for the COREHANDLE
27     # + former public COREHANDLE becomes private _COREHANDLE now
28     #
29 joko 1.9 # Revision 1.8 2002/12/01 22:20:43 joko
30     # + sub createDb (from Storage.pm)
31     #
32 joko 1.8 # Revision 1.7 2002/12/01 07:09:09 joko
33     # + sub getListFiltered (dummy redirecting to getListUnfiltered)
34     #
35 joko 1.7 # Revision 1.6 2002/12/01 04:46:01 joko
36     # + sub eraseAll
37     #
38 joko 1.6 # Revision 1.5 2002/11/29 05:00:26 joko
39     # + sub getListUnfiltered
40     # + sub sendQuery
41     #
42 joko 1.5 # Revision 1.4 2002/11/17 08:46:42 jonen
43     # + wrapped eval around DBI->connect to prevent deaths
44     #
45 jonen 1.4 # Revision 1.3 2002/11/17 06:34:39 joko
46     # + locator metadata can now be reached via ->{locator}
47     # - sub hash2sql now taken from libdb
48     #
49 joko 1.3 # Revision 1.2 2002/10/25 11:43:27 joko
50     # + enhanced robustness
51     # + more logging for debug-levels
52     #
53 joko 1.2 # Revision 1.1 2002/10/10 03:44:07 cvsjoko
54     # + new
55 cvsjoko 1.1 #
56     #
57     #################################
58    
59     package Data::Storage::Handler::DBI;
60    
61     use strict;
62     use warnings;
63    
64     use base ("Data::Storage::Handler::Abstract");
65    
66 joko 1.13
67 cvsjoko 1.1 use DBI;
68 joko 1.3 use Data::Dumper;
69 joko 1.15 use shortcuts::database qw( hash2sql dsn2dbname );
70 joko 1.5 use Data::Storage::Result::DBI;
71 cvsjoko 1.1
72 joko 1.13
73 cvsjoko 1.1 # get logger instance
74     my $logger = Log::Dispatch::Config->instance;
75    
76    
77 joko 1.5 sub getMetaInfo {
78     my $self = shift;
79     $logger->debug( __PACKAGE__ . "->getMetaInfo()" );
80     return {
81     'disconnectMethod' => 'disconnect',
82     };
83     }
84 cvsjoko 1.1
85     sub connect {
86    
87     my $self = shift;
88    
89     # create handle
90 joko 1.3 if ( my $dsn = $self->{locator}->{dbi}->{dsn} ) {
91     #if ( my $dsn = $self->{locator}->{dsn} ) {
92 joko 1.2 $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
93    
94     # HACK:
95     # set errorhandler before actually calling DBI->connect
96     # in order to catch errors from the very beginning
97     #DBI->{HandleError} = $self->{dbi}->{HandleError};
98    
99     #use Data::Dumper; print Dumper($self->{dbi});
100    
101 jonen 1.4 eval {
102 joko 1.9 $self->{_COREHANDLE} = DBI->connect( $dsn, '', '', $self->{locator}->{dbi} );
103     if (!$self->{_COREHANDLE}) {
104 jonen 1.4 $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr );
105     return;
106     }
107     };
108     $logger->warning( __PACKAGE__ . "->connect failed: " . $@ ) if $@;
109    
110 cvsjoko 1.1 }
111     $self->configureCOREHANDLE();
112 joko 1.3
113     $self->{locator}->{status}->{connected} = 1;
114    
115 joko 1.2 return 1;
116    
117 cvsjoko 1.1 }
118    
119     sub configureCOREHANDLE {
120    
121     my $self = shift;
122    
123 joko 1.3 $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" );
124 cvsjoko 1.1
125 joko 1.9 return if !$self->{_COREHANDLE};
126 joko 1.8
127 joko 1.5 # apply configured modifications to DBI-handle
128 joko 1.3 if (exists $self->{locator}->{dbi}->{trace_level} && exists $self->{locator}->{dbi}->{trace_file}) {
129 joko 1.9 $self->{_COREHANDLE}->trace($self->{locator}->{dbi}->{trace_level}, $self->{locator}->{dbi}->{trace_file});
130 cvsjoko 1.1 }
131 joko 1.3 if (exists $self->{locator}->{dbi}->{RaiseError}) {
132 joko 1.9 $self->{_COREHANDLE}->{RaiseError} = $self->{locator}->{dbi}->{RaiseError};
133 cvsjoko 1.1 }
134 joko 1.3 if (exists $self->{locator}->{dbi}->{PrintError}) {
135 joko 1.9 $self->{_COREHANDLE}->{PrintError} = $self->{locator}->{dbi}->{PrintError};
136 cvsjoko 1.1 }
137 joko 1.3 if (exists $self->{locator}->{dbi}->{HandleError}) {
138 joko 1.9 $self->{_COREHANDLE}->{HandleError} = $self->{locator}->{dbi}->{HandleError};
139 cvsjoko 1.1 }
140    
141     }
142    
143     sub _sendSql {
144     my $self = shift;
145     my $sql = shift;
146 joko 1.2
147 joko 1.16 # pre-flight check: is $sql defined?
148     if (!$sql) {
149     $logger->warning( __PACKAGE__ . "->_sendSql: \$sql was empty." );
150     return;
151     }
152    
153 joko 1.2 # two-level handling for implicit connect:
154     # if there's no corehandle ...
155 joko 1.9 if (!$self->{_COREHANDLE}) {
156 joko 1.2 # ... try to connect, but ...
157     $self->connect();
158     # ... if this still fails, there's something wrong probably, so we won't continue
159 joko 1.9 if (!$self->{_COREHANDLE}) {
160 joko 1.2 return;
161     }
162     }
163    
164 joko 1.3 #print "prepare sql: $sql\n";
165    
166 joko 1.9 my $sth = $self->{_COREHANDLE}->prepare($sql);
167 cvsjoko 1.1 $sth->execute();
168     return $sth;
169     }
170    
171     sub sendCommand {
172     my $self = shift;
173     my $command = shift;
174 joko 1.5 # TODO: when tracing: yes, do actually log this
175 joko 1.2 #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" );
176 cvsjoko 1.1 my $cmdHandle = $self->_sendSql($command);
177     my $result = Data::Storage::Result::DBI->new( RESULTHANDLE => $cmdHandle );
178     return $result;
179     }
180    
181     sub getChildNodes {
182     my $self = shift;
183     my @nodes;
184 joko 1.3 $logger->debug( __PACKAGE__ . "->getChildNodes()" );
185 joko 1.9 my $locator = $self->{locator};
186     #print Dumper($locator); exit;
187 cvsjoko 1.1 if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
188 joko 1.13 my $dbname = dsn2dbname($self->{locator}->{dbi}->{dsn});
189 joko 1.3 my $key = "Tables_in_$dbname";
190 joko 1.5 while ( my $row = $result->getNextEntry() ) {
191 joko 1.3 push @nodes, $row->{$key};
192 cvsjoko 1.1 }
193     }
194     return \@nodes;
195     }
196    
197 joko 1.5 sub getListUnfiltered {
198 cvsjoko 1.1 my $self = shift;
199 joko 1.5 my $nodename = shift;
200     my @list;
201     $logger->debug( __PACKAGE__ . "->getListUnfiltered( nodename => '" . $nodename . "' )" );
202     # get list of rows from rdbms by table name
203     my $result = $self->sendCommand("SELECT * FROM $nodename");
204     while ( my $row = $result->getNextEntry() ) {
205     push @list, $row;
206     }
207     return \@list;
208 cvsjoko 1.1 }
209    
210 joko 1.5 sub sendQuery {
211 cvsjoko 1.1 my $self = shift;
212 joko 1.5 my $query = shift;
213 joko 1.10
214     $logger->debug( __PACKAGE__ . "->sendQuery" );
215    
216 joko 1.16 my $crud = $query->{options}->{crud};
217     $crud ||= $query->{options}->{action};
218     $crud ||= 'RETRIEVE';
219 joko 1.14
220     if (my $guid = $query->{options}->{GUID}) {
221     $query->{criterias} = [ { key => 'guid', op => 'eq', val => $guid } ];
222     }
223    
224     # check criterias (load & save)
225 joko 1.5 #my $sql = "SELECT cs FROM $self->{metainfo}->{$descent}->{node} WHERE $self->{metainfo}->{$descent}->{IdentProvider}->{arg}='$self->{entry}->{source}->{ident}';";
226     #my $result = $self->{metainfo}->{$descent}->{storage}->sendCommand($sql);
227     my @crits;
228     foreach (@{$query->{criterias}}) {
229     my $op = '';
230     $op = '=' if lc $_->{op} eq 'eq';
231     push @crits, "$_->{key}$op'$_->{val}'";
232     }
233 joko 1.14 # HACK: this is hardcoded ;( expand possibilities!
234     my $crit = join(' AND ', @crits);
235    
236     # check subnodes (load)
237 joko 1.5 my $subnodes = {};
238     map { $subnodes->{$_}++ } @{$query->{subnodes}};
239 joko 1.14
240     # check payload (save)
241     #print Dumper($query->{payload});
242     #$subnodes ||= $query->{payload};
243    
244     # dispatch action
245 joko 1.16 if ($crud eq 'RETRIEVE') {
246 joko 1.14 my $sql = hash2sql($query->{node}, $subnodes, 'SELECT', $crit);
247     return $self->sendCommand($sql);
248 joko 1.16
249     } elsif ($crud eq 'UPDATE') {
250 joko 1.14 my $sql = hash2sql($query->{node}, $query->{payload}, 'UPDATE', $crit);
251     $self->sendCommand($sql);
252 joko 1.16
253     } elsif ($crud eq 'DELETE') {
254     my $sql = hash2sql($query->{node}, $query->{payload}, 'DELETE', $crit);
255     $self->sendCommand($sql);
256    
257 joko 1.14 }
258    
259 joko 1.6 }
260    
261     sub eraseAll {
262     my $self = shift;
263     my $classname = shift;
264 joko 1.10 $logger->debug( __PACKAGE__ . "->eraseAll" );
265 joko 1.6 my $sql = "DELETE FROM $classname";
266     $self->sendCommand($sql);
267 joko 1.7 }
268    
269     # TODO: actually implement the filtering functionality using $this->sendQuery
270     sub getListFiltered {
271     my $self = shift;
272     my $nodename = shift;
273     return $self->getListUnfiltered($nodename);
274 joko 1.8 }
275    
276     # TODO: do this via a parametrized "$self->connect(<connect just to database server - don't select database>)"
277     sub createDb {
278    
279     my $self = shift;
280    
281     # get dsn from Data::Storage::Locator instance
282     my $dsn = $self->{locator}->{dbi}->{dsn};
283    
284     $logger->debug( __PACKAGE__ . "->createDb( dsn $dsn )" );
285    
286     # remove database setting from dsn-string
287     $dsn =~ s/database=(.+?);//;
288    
289     # remember extracted database name to know what actually to create right now
290     my $database_name = $1;
291    
292     # flag to indicate goodness
293     my $ok;
294    
295     # connect to database server - don't select/use any specific database
296     #if ( my $dbh = DBI->connect($dsn, '', '', { PrintError => 0 } ) ) {
297     if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) {
298    
299     if ($database_name) {
300     if ($dbh->do("CREATE DATABASE $database_name")) {
301     $ok = 1;
302     }
303     }
304    
305     $dbh->disconnect();
306    
307     }
308    
309     return $ok;
310    
311 joko 1.9 }
312    
313     sub getCOREHANDLE2 {
314     my $self = shift;
315     return $self->{_COREHANDLE};
316 joko 1.11 }
317    
318     sub dropDb {
319     my $self = shift;
320     my $dsn = $self->{locator}->{dbi}->{dsn};
321    
322     $logger->debug( __PACKAGE__ . "->dropDb( dsn $dsn )" );
323    
324     $dsn =~ s/database=(.+?);//;
325     my $database_name = $1;
326    
327     my $ok;
328    
329     if ( my $dbh = DBI->connect($dsn, '', '', {
330     PrintError => 0,
331     } ) ) {
332     if ($database_name) {
333     if ($dbh->do("DROP DATABASE $database_name;")) {
334     $ok = 1;
335     }
336     }
337    
338     $dbh->disconnect();
339    
340     }
341    
342     return $ok;
343     }
344    
345     sub rebuildDb {
346     my $self = shift;
347     $logger->info( __PACKAGE__ . "->rebuildDb()" );
348     my @results;
349    
350     # sum up results (bool (0/1)) in array
351     #push @results, $self->retreatSchema();
352     push @results, $self->dropDb();
353     push @results, $self->createDb();
354     #push @results, $self->deploySchema();
355    
356     # scan array for "bad ones"
357     my $res = 1;
358     map {
359     $res = 0 if (!$_);
360     } @results;
361    
362     return $res;
363 cvsjoko 1.1 }
364    
365 joko 1.12 sub testAvailability {
366     my $self = shift;
367     my $status = $self->testDsn();
368     $self->{locator}->{status}->{available} = $status;
369     return $status;
370     }
371    
372     sub testDsn {
373     my $self = shift;
374     my $dsn = $self->{locator}->{dbi}->{dsn};
375     my $result;
376     if ( my $dbh = DBI->connect($dsn, '', '', {
377     PrintError => 0,
378     } ) ) {
379    
380     # TODO: REVIEW
381     $dbh->disconnect();
382    
383     return 1;
384     } else {
385     $logger->warning( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
386     }
387     }
388    
389 jonen 1.4 1;
390 joko 1.12 __END__

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed