/[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.3 - (show annotations)
Sun Nov 17 06:34:39 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.2: +29 -63 lines
+ locator metadata can now be reached via ->{locator}
- sub hash2sql now taken from libdb

1 #################################
2 #
3 # $Id: DBI.pm,v 1.2 2002/10/25 11:43:27 joko Exp $
4 #
5 # $Log: DBI.pm,v $
6 # Revision 1.2 2002/10/25 11:43:27 joko
7 # + enhanced robustness
8 # + more logging for debug-levels
9 #
10 # Revision 1.1 2002/10/10 03:44:07 cvsjoko
11 # + new
12 #
13 #
14 #################################
15
16 package Data::Storage::Handler::DBI;
17
18 use strict;
19 use warnings;
20
21 use base ("Data::Storage::Handler::Abstract");
22
23 use DBI;
24 use Data::Dumper;
25 use libdb;
26
27 # get logger instance
28 my $logger = Log::Dispatch::Config->instance;
29
30
31 our $metainfo = {
32 'disconnectMethod' => 'disconnect',
33 };
34
35 sub connect {
36
37 my $self = shift;
38
39 # create handle
40 if ( my $dsn = $self->{locator}->{dbi}->{dsn} ) {
41 #if ( my $dsn = $self->{locator}->{dsn} ) {
42 $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
43
44 # HACK:
45 # set errorhandler before actually calling DBI->connect
46 # in order to catch errors from the very beginning
47 #DBI->{HandleError} = $self->{dbi}->{HandleError};
48
49 #use Data::Dumper; print Dumper($self->{dbi});
50
51 $self->{COREHANDLE} = DBI->connect( $dsn, '', '', $self->{locator}->{dbi} );
52 if (!$self->{COREHANDLE}) {
53 $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr );
54 return;
55 }
56 }
57 $self->configureCOREHANDLE();
58
59 $self->{locator}->{status}->{connected} = 1;
60
61 return 1;
62
63 }
64
65 sub configureCOREHANDLE {
66
67 my $self = shift;
68
69 $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" );
70
71 # apply configured modifications
72 if (exists $self->{locator}->{dbi}->{trace_level} && exists $self->{locator}->{dbi}->{trace_file}) {
73 $self->{COREHANDLE}->trace($self->{locator}->{dbi}->{trace_level}, $self->{locator}->{dbi}->{trace_file});
74 }
75 if (exists $self->{locator}->{dbi}->{RaiseError}) {
76 $self->{COREHANDLE}->{RaiseError} = $self->{locator}->{dbi}->{RaiseError};
77 }
78 if (exists $self->{locator}->{dbi}->{PrintError}) {
79 $self->{COREHANDLE}->{PrintError} = $self->{locator}->{dbi}->{PrintError};
80 }
81 if (exists $self->{locator}->{dbi}->{HandleError}) {
82 $self->{COREHANDLE}->{HandleError} = $self->{locator}->{dbi}->{HandleError};
83 }
84
85 }
86
87 sub _sendSql {
88 my $self = shift;
89 my $sql = shift;
90
91 # two-level handling for implicit connect:
92 # if there's no corehandle ...
93 if (!$self->{COREHANDLE}) {
94 # ... try to connect, but ...
95 $self->connect();
96 # ... if this still fails, there's something wrong probably, so we won't continue
97 if (!$self->{COREHANDLE}) {
98 return;
99 }
100 }
101
102 #print "prepare sql: $sql\n";
103
104 my $sth = $self->{COREHANDLE}->prepare($sql);
105 $sth->execute();
106 return $sth;
107 }
108
109 sub sendCommand {
110 my $self = shift;
111 my $command = shift;
112 #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" );
113 my $cmdHandle = $self->_sendSql($command);
114 my $result = Data::Storage::Result::DBI->new( RESULTHANDLE => $cmdHandle );
115 return $result;
116 }
117
118 sub quoteSql {
119 my $self = shift;
120 my $string = shift;
121 if ($string) {
122 $string =~ s/'/\\'/g;
123 }
124 return $string;
125 }
126
127
128 sub getChildNodes {
129
130 my $self = shift;
131 my @nodes;
132
133 $logger->debug( __PACKAGE__ . "->getChildNodes()" );
134
135 if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
136 my $dbname = getDbNameByDsn($self->{locator}->{dbi}->{dsn});
137 my $key = "Tables_in_$dbname";
138 while ( my $row = $result->_getNextEntry() ) {
139 push @nodes, $row->{$key};
140 }
141 }
142
143 return \@nodes;
144
145 }
146
147
148
149
150 package Data::Storage::Result::DBI;
151
152 use strict;
153 use warnings;
154
155 use base ("Data::Storage::Result");
156
157 sub DESTROY {
158 my $self = shift;
159 #$logger->debug( __PACKAGE__ . "->" . "DESTROY" );
160 $self->{RESULTHANDLE} && $self->{RESULTHANDLE}->finish();
161 }
162
163 sub _getNextEntry {
164 my $self = shift;
165 $self->{RESULTHANDLE} && return $self->{RESULTHANDLE}->fetchrow_hashref;
166 }
167
168
169 1;

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