/[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.17 - (hide annotations)
Sat Jun 19 01:49:47 2004 UTC (20 years ago) by joko
Branch: MAIN
CVS Tags: HEAD
Changes since 1.16: +7 -2 lines
(re-)activated "getCOREHANDLE"

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

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