/[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.14 - (hide annotations)
Wed Apr 9 06:06:04 2003 UTC (21 years, 3 months ago) by joko
Branch: MAIN
Changes since 1.13: +30 -5 lines
sendQuery now is capable of doing 'SELECT'- or 'INSERT'-queries

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

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