/[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.2 - (hide annotations)
Fri Oct 25 11:43:27 2002 UTC (21 years, 8 months ago) by joko
Branch: MAIN
Changes since 1.1: +43 -6 lines
+ enhanced robustness
+ more logging for debug-levels

1 cvsjoko 1.1 #################################
2     #
3 joko 1.2 # $Id: DBI.pm,v 1.1 2002/10/10 03:44:07 cvsjoko Exp $
4     #
5     # $Log: DBI.pm,v $
6     # Revision 1.1 2002/10/10 03:44:07 cvsjoko
7     # + new
8 cvsjoko 1.1 #
9     #
10     #################################
11    
12     package Data::Storage::Handler::DBI;
13    
14     use strict;
15     use warnings;
16    
17     use base ("Data::Storage::Handler::Abstract");
18    
19     use DBI;
20    
21     # get logger instance
22     my $logger = Log::Dispatch::Config->instance;
23    
24    
25     our $metainfo = {
26     'disconnectMethod' => 'disconnect',
27     };
28    
29     sub connect {
30    
31     my $self = shift;
32    
33     # create handle
34     if ( my $dsn = $self->{dbi}->{dsn} ) {
35 joko 1.2 $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
36    
37     # HACK:
38     # set errorhandler before actually calling DBI->connect
39     # in order to catch errors from the very beginning
40     #DBI->{HandleError} = $self->{dbi}->{HandleError};
41    
42     #use Data::Dumper; print Dumper($self->{dbi});
43    
44     $self->{COREHANDLE} = DBI->connect(
45     $dsn, '', '', {
46     RaiseError => $self->{dbi}->{RaiseError},
47     #RaiseError => 1,
48     PrintError => $self->{dbi}->{PrintError},
49     HandleError => $self->{dbi}->{HandleError},
50     }
51     );
52     if (!$self->{COREHANDLE}) {
53     $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr );
54     return;
55     }
56 cvsjoko 1.1 }
57     $self->configureCOREHANDLE();
58    
59 joko 1.2 return 1;
60    
61 cvsjoko 1.1 }
62    
63     sub configureCOREHANDLE {
64    
65     my $self = shift;
66    
67     $logger->debug( __PACKAGE__ . "->_configureCOREHANDLE" );
68    
69     # apply configured modifications
70     if (exists $self->{dbi}->{trace_level} && exists $self->{dbi}->{trace_file}) {
71     $self->{COREHANDLE}->trace($self->{dbi}->{trace_level}, $self->{dbi}->{trace_file});
72     }
73     if (exists $self->{dbi}->{RaiseError}) {
74     $self->{COREHANDLE}->{RaiseError} = $self->{dbi}->{RaiseError};
75     }
76     if (exists $self->{dbi}->{PrintError}) {
77     $self->{COREHANDLE}->{PrintError} = $self->{dbi}->{PrintError};
78     }
79     if (exists $self->{dbi}->{HandleError}) {
80     $self->{COREHANDLE}->{HandleError} = $self->{dbi}->{HandleError};
81     }
82    
83     }
84    
85     sub _sendSql {
86     my $self = shift;
87     my $sql = shift;
88 joko 1.2
89     # two-level handling for implicit connect:
90     # if there's no corehandle ...
91     if (!$self->{COREHANDLE}) {
92     # ... try to connect, but ...
93     $self->connect();
94     # ... if this still fails, there's something wrong probably, so we won't continue
95     if (!$self->{COREHANDLE}) {
96     return;
97     }
98     }
99    
100 cvsjoko 1.1 my $sth = $self->{COREHANDLE}->prepare($sql);
101     $sth->execute();
102     return $sth;
103     }
104    
105     sub sendCommand {
106     my $self = shift;
107     my $command = shift;
108 joko 1.2 #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" );
109 cvsjoko 1.1 my $cmdHandle = $self->_sendSql($command);
110     my $result = Data::Storage::Result::DBI->new( RESULTHANDLE => $cmdHandle );
111     return $result;
112     }
113    
114     sub quoteSql {
115     my $self = shift;
116     my $string = shift;
117     if ($string) {
118     $string =~ s/'/\\'/g;
119     }
120     return $string;
121     }
122    
123     sub hash2Sql {
124    
125     my $self = shift;
126    
127     my $table = shift;
128     my $hash = shift;
129     my $mode = shift;
130     my $crit = shift;
131    
132     my $sql;
133     if ($mode eq 'SQL_INSERT') {
134     $sql = "INSERT INTO $table (#fields#) VALUES (#values#);";
135     }
136     if ($mode eq 'SQL_UPDATE') {
137     $sql = "UPDATE $table SET #fields-values# WHERE $crit;";
138     }
139    
140     my (@fields, @values);
141     foreach my $key (keys %{$hash}) {
142     push @fields, $key;
143     push @values, $hash->{$key};
144     }
145     # quote each element
146     map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values;
147    
148     my $fields = join(', ', @fields);
149     my $values = join(', ', @values);
150     my $fields_values = '';
151     my $fc = 0;
152     foreach (@fields) {
153     $fields_values .= $_ . '=' . $values[$fc] . ', ';
154     $fc++;
155     }
156     $fields_values = substr($fields_values, 0, -2);
157    
158     $sql =~ s/#fields#/$fields/;
159     $sql =~ s/#values#/$values/;
160     $sql =~ s/#fields-values#/$fields_values/;
161    
162     return $sql;
163     }
164    
165    
166     sub getChildNodes {
167    
168     my $self = shift;
169     my @nodes;
170    
171     if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
172     while ( my $row = $result->_getNextEntry() ) {
173     push @nodes, $row;
174     }
175     }
176    
177     return \@nodes;
178    
179     }
180    
181    
182    
183    
184     package Data::Storage::Result::DBI;
185    
186     use strict;
187     use warnings;
188    
189     use base ("Data::Storage::Result");
190    
191     sub DESTROY {
192     my $self = shift;
193     #$logger->debug( __PACKAGE__ . "->" . "DESTROY" );
194 joko 1.2 $self->{RESULTHANDLE} && $self->{RESULTHANDLE}->finish();
195 cvsjoko 1.1 }
196    
197     sub _getNextEntry {
198     my $self = shift;
199 joko 1.2 $self->{RESULTHANDLE} && return $self->{RESULTHANDLE}->fetchrow_hashref;
200 cvsjoko 1.1 }
201    
202    
203     1;

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