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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (show annotations)
Wed Apr 9 07:53:33 2003 UTC (21 years, 3 months ago) by joko
Branch: MAIN
Changes since 1.14: +5 -2 lines
minor namespace update

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

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