/[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.11 - (show annotations)
Thu Dec 19 16:31:05 2002 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.10: +51 -1 lines
+ sub dropDb
+ sub rebuildDb

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

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