/[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.3 - (hide 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 cvsjoko 1.1 #################################
2     #
3 joko 1.3 # $Id: DBI.pm,v 1.2 2002/10/25 11:43:27 joko Exp $
4 joko 1.2 #
5     # $Log: DBI.pm,v $
6 joko 1.3 # Revision 1.2 2002/10/25 11:43:27 joko
7     # + enhanced robustness
8     # + more logging for debug-levels
9     #
10 joko 1.2 # Revision 1.1 2002/10/10 03:44:07 cvsjoko
11     # + new
12 cvsjoko 1.1 #
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 joko 1.3 use Data::Dumper;
25     use libdb;
26 cvsjoko 1.1
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 joko 1.3 if ( my $dsn = $self->{locator}->{dbi}->{dsn} ) {
41     #if ( my $dsn = $self->{locator}->{dsn} ) {
42 joko 1.2 $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 joko 1.3 $self->{COREHANDLE} = DBI->connect( $dsn, '', '', $self->{locator}->{dbi} );
52 joko 1.2 if (!$self->{COREHANDLE}) {
53     $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr );
54     return;
55     }
56 cvsjoko 1.1 }
57     $self->configureCOREHANDLE();
58 joko 1.3
59     $self->{locator}->{status}->{connected} = 1;
60    
61 joko 1.2 return 1;
62    
63 cvsjoko 1.1 }
64    
65     sub configureCOREHANDLE {
66    
67     my $self = shift;
68    
69 joko 1.3 $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" );
70 cvsjoko 1.1
71     # apply configured modifications
72 joko 1.3 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 cvsjoko 1.1 }
75 joko 1.3 if (exists $self->{locator}->{dbi}->{RaiseError}) {
76     $self->{COREHANDLE}->{RaiseError} = $self->{locator}->{dbi}->{RaiseError};
77 cvsjoko 1.1 }
78 joko 1.3 if (exists $self->{locator}->{dbi}->{PrintError}) {
79     $self->{COREHANDLE}->{PrintError} = $self->{locator}->{dbi}->{PrintError};
80 cvsjoko 1.1 }
81 joko 1.3 if (exists $self->{locator}->{dbi}->{HandleError}) {
82     $self->{COREHANDLE}->{HandleError} = $self->{locator}->{dbi}->{HandleError};
83 cvsjoko 1.1 }
84    
85     }
86    
87     sub _sendSql {
88     my $self = shift;
89     my $sql = shift;
90 joko 1.2
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 joko 1.3 #print "prepare sql: $sql\n";
103    
104 cvsjoko 1.1 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 joko 1.2 #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" );
113 cvsjoko 1.1 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 joko 1.3 $logger->debug( __PACKAGE__ . "->getChildNodes()" );
134    
135 cvsjoko 1.1 if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
136 joko 1.3 my $dbname = getDbNameByDsn($self->{locator}->{dbi}->{dsn});
137     my $key = "Tables_in_$dbname";
138 cvsjoko 1.1 while ( my $row = $result->_getNextEntry() ) {
139 joko 1.3 push @nodes, $row->{$key};
140 cvsjoko 1.1 }
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 joko 1.2 $self->{RESULTHANDLE} && $self->{RESULTHANDLE}->finish();
161 cvsjoko 1.1 }
162    
163     sub _getNextEntry {
164     my $self = shift;
165 joko 1.2 $self->{RESULTHANDLE} && return $self->{RESULTHANDLE}->fetchrow_hashref;
166 cvsjoko 1.1 }
167    
168    
169     1;

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