Storage/Handler/DBI.pm

#################################
#
#  $Id: DBI.pm,v 1.11 2002/12/19 16:31:05 joko Exp $
#
#  $Log: DBI.pm,v $
#  Revision 1.11  2002/12/19 16:31:05  joko
#  + sub dropDb
#  + sub rebuildDb
#
#  Revision 1.10  2002/12/15 02:02:22  joko
#  + fixed logging-message
#
#  Revision 1.9  2002/12/05 07:58:20  joko
#  + now using Tie::SecureHash as a base for the COREHANDLE
#  + former public COREHANDLE becomes private _COREHANDLE now
#
#  Revision 1.8  2002/12/01 22:20:43  joko
#  + sub createDb (from Storage.pm)
#
#  Revision 1.7  2002/12/01 07:09:09  joko
#  + sub getListFiltered (dummy redirecting to getListUnfiltered)
#
#  Revision 1.6  2002/12/01 04:46:01  joko
#  + sub eraseAll
#
#  Revision 1.5  2002/11/29 05:00:26  joko
#  + sub getListUnfiltered
#  + sub sendQuery
#
#  Revision 1.4  2002/11/17 08:46:42  jonen
#  + wrapped eval around DBI->connect to prevent deaths
#
#  Revision 1.3  2002/11/17 06:34:39  joko
#  + locator metadata can now be reached via ->{locator}
#  - sub hash2sql now taken from libdb
#
#  Revision 1.2  2002/10/25 11:43:27  joko
#  + enhanced robustness
#  + more logging for debug-levels
#
#  Revision 1.1  2002/10/10 03:44:07  cvsjoko
#  + new
#
#
#################################

package Data::Storage::Handler::DBI;

use strict;
use warnings;

use base ("Data::Storage::Handler::Abstract");

use DBI;
use Data::Dumper;
use libdb qw( getDbNameByDsn hash2Sql );
use Data::Storage::Result::DBI;

# get logger instance
my $logger = Log::Dispatch::Config->instance;


sub getMetaInfo {
  my $self = shift;
  $logger->debug( __PACKAGE__ . "->getMetaInfo()"  );
  return {
    'disconnectMethod' => 'disconnect',
  };
}

sub connect {

    my $self = shift;
    
    # create handle
      if ( my $dsn = $self->{locator}->{dbi}->{dsn} ) {
      #if ( my $dsn = $self->{locator}->{dsn} ) {
        $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
        
        # HACK:
        # set errorhandler before actually calling DBI->connect 
        # in order to catch errors from the very beginning
        #DBI->{HandleError} = $self->{dbi}->{HandleError};
        
        #use Data::Dumper; print Dumper($self->{dbi});
        
        eval {
          $self->{_COREHANDLE} = DBI->connect( $dsn, '', '', $self->{locator}->{dbi} );
          if (!$self->{_COREHANDLE}) {
            $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr );
            return;
          }
        };
        $logger->warning( __PACKAGE__ . "->connect failed: " . $@ ) if $@;

      }
      $self->configureCOREHANDLE();

    $self->{locator}->{status}->{connected} = 1;

    return 1;
    
}

sub configureCOREHANDLE {

  my $self = shift;

  $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" );

  return if !$self->{_COREHANDLE};

  # apply configured modifications to DBI-handle
    if (exists $self->{locator}->{dbi}->{trace_level} && exists $self->{locator}->{dbi}->{trace_file}) {
      $self->{_COREHANDLE}->trace($self->{locator}->{dbi}->{trace_level}, $self->{locator}->{dbi}->{trace_file});
    }
    if (exists $self->{locator}->{dbi}->{RaiseError}) {
      $self->{_COREHANDLE}->{RaiseError} = $self->{locator}->{dbi}->{RaiseError};
    }
    if (exists $self->{locator}->{dbi}->{PrintError}) {
      $self->{_COREHANDLE}->{PrintError} = $self->{locator}->{dbi}->{PrintError};
    }
    if (exists $self->{locator}->{dbi}->{HandleError}) {
      $self->{_COREHANDLE}->{HandleError} = $self->{locator}->{dbi}->{HandleError};
    }

}

sub _sendSql {
  my $self = shift;
  my $sql = shift;
  
  # two-level handling for implicit connect:
  # if there's no corehandle ...
  if (!$self->{_COREHANDLE}) {
    # ... try to connect, but ...
    $self->connect();
    # ... if this still fails, there's something wrong probably, so we won't continue
    if (!$self->{_COREHANDLE}) {
      return;
    }
  }
  
  #print "prepare sql: $sql\n";
  
  my $sth = $self->{_COREHANDLE}->prepare($sql);
  $sth->execute();
  return $sth;
}

sub sendCommand {
  my $self = shift;
  my $command = shift;
  # TODO: when tracing: yes, do actually log this
  #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" );
  my $cmdHandle = $self->_sendSql($command);
  my $result = Data::Storage::Result::DBI->new( RESULTHANDLE => $cmdHandle );
  return $result;
}

sub getChildNodes {
  my $self = shift;
  my @nodes;
  $logger->debug( __PACKAGE__ . "->getChildNodes()" );
  my $locator = $self->{locator};
  #print Dumper($locator); exit;
  if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
    my $dbname = getDbNameByDsn($self->{locator}->{dbi}->{dsn});
    my $key = "Tables_in_$dbname";
    while ( my $row = $result->getNextEntry() ) {
      push @nodes, $row->{$key};
    }
  }
  return \@nodes;
}

sub getListUnfiltered {
  my $self = shift;
  my $nodename = shift;
  my @list;
  $logger->debug( __PACKAGE__ . "->getListUnfiltered( nodename => '" . $nodename . "' )" );
  # get list of rows from rdbms by table name
  my $result = $self->sendCommand("SELECT * FROM $nodename");
  while ( my $row = $result->getNextEntry() ) {
    push @list, $row;
  }
  return \@list;
}

sub sendQuery {
  my $self = shift;
  my $query = shift;

  $logger->debug( __PACKAGE__ . "->sendQuery" );

  #my $sql = "SELECT cs FROM $self->{metainfo}->{$descent}->{node} WHERE $self->{metainfo}->{$descent}->{IdentProvider}->{arg}='$self->{entry}->{source}->{ident}';";
  #my $result = $self->{metainfo}->{$descent}->{storage}->sendCommand($sql);
  my @crits;
  foreach (@{$query->{criterias}}) {
    my $op = '';
    $op = '=' if lc $_->{op} eq 'eq';
    push @crits, "$_->{key}$op'$_->{val}'";
  }
  my $subnodes = {};
  map { $subnodes->{$_}++ } @{$query->{subnodes}};
  # HACK: this is hardcoded ;(    expand possibilities!
  my $crit = join(' AND ', @crits);
  my $sql = hash2Sql($query->{node}, $subnodes, 'SELECT', $crit);
  return $self->sendCommand($sql);
}

sub eraseAll {
  my $self = shift;
  my $classname = shift;
  $logger->debug( __PACKAGE__ . "->eraseAll" );
  my $sql = "DELETE FROM $classname";
  $self->sendCommand($sql);
}

# TODO: actually implement the filtering functionality using $this->sendQuery
sub getListFiltered {
  my $self = shift;
  my $nodename = shift;
  return $self->getListUnfiltered($nodename);
}

# TODO: do this via a parametrized "$self->connect(<connect just to database server - don't select database>)"
sub createDb {
  
  my $self = shift;
  
  # get dsn from Data::Storage::Locator instance
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );

  # remove database setting from dsn-string
  $dsn =~ s/database=(.+?);//;
  
  # remember extracted database name to know what actually to create right now
  my $database_name = $1;

  # flag to indicate goodness
  my $ok;
  
  # connect to database server - don't select/use any specific database
  #if ( my $dbh = DBI->connect($dsn, '', '', { PrintError => 0 } ) ) {
  if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) {

    if ($database_name) {
      if ($dbh->do("CREATE DATABASE $database_name")) {
        $ok = 1;
      }
    }

    $dbh->disconnect();

  }
  
  return $ok;
  
}

sub getCOREHANDLE2 {
  my $self = shift;
  return $self->{_COREHANDLE};
}

sub dropDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );

  $dsn =~ s/database=(.+?);//;
  my $database_name = $1;

  my $ok;
  
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    if ($database_name) {
      if ($dbh->do("DROP DATABASE $database_name;")) {
        $ok = 1;
      }
    }

    $dbh->disconnect();

  }
  
  return $ok;
}

sub rebuildDb {
  my $self = shift;
  $logger->info( __PACKAGE__ . "->rebuildDb()" );
  my @results;

  # sum up results (bool (0/1)) in array
  #push @results, $self->retreatSchema();
  push @results, $self->dropDb();
  push @results, $self->createDb();
  #push @results, $self->deploySchema();

  # scan array for "bad ones"
  my $res = 1;
  map {
    $res = 0 if (!$_);
  } @results;
  
  return $res;
}

sub testAvailability {
  my $self = shift;
  my $status = $self->testDsn();
  $self->{locator}->{status}->{available} = $status;
  return $status;
}

sub testDsn {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    
    # TODO: REVIEW
    $dbh->disconnect();
    
    return 1;
  } else {
    $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
  }
}

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