/[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.6 - (hide annotations)
Sun Dec 1 04:46:01 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.5: +12 -1 lines
+ sub eraseAll

1 cvsjoko 1.1 #################################
2     #
3 joko 1.6 # $Id: DBI.pm,v 1.5 2002/11/29 05:00:26 joko Exp $
4 joko 1.2 #
5     # $Log: DBI.pm,v $
6 joko 1.6 # Revision 1.5 2002/11/29 05:00:26 joko
7     # + sub getListUnfiltered
8     # + sub sendQuery
9     #
10 joko 1.5 # Revision 1.4 2002/11/17 08:46:42 jonen
11     # + wrapped eval around DBI->connect to prevent deaths
12     #
13 jonen 1.4 # Revision 1.3 2002/11/17 06:34:39 joko
14     # + locator metadata can now be reached via ->{locator}
15     # - sub hash2sql now taken from libdb
16     #
17 joko 1.3 # Revision 1.2 2002/10/25 11:43:27 joko
18     # + enhanced robustness
19     # + more logging for debug-levels
20     #
21 joko 1.2 # Revision 1.1 2002/10/10 03:44:07 cvsjoko
22     # + new
23 cvsjoko 1.1 #
24     #
25     #################################
26    
27     package Data::Storage::Handler::DBI;
28    
29     use strict;
30     use warnings;
31    
32     use base ("Data::Storage::Handler::Abstract");
33    
34     use DBI;
35 joko 1.3 use Data::Dumper;
36 joko 1.5 use libdb qw( getDbNameByDsn hash2Sql );
37     use Data::Storage::Result::DBI;
38 cvsjoko 1.1
39     # get logger instance
40     my $logger = Log::Dispatch::Config->instance;
41    
42    
43 joko 1.5 sub getMetaInfo {
44     my $self = shift;
45     $logger->debug( __PACKAGE__ . "->getMetaInfo()" );
46     return {
47     'disconnectMethod' => 'disconnect',
48     };
49     }
50 cvsjoko 1.1
51     sub connect {
52    
53     my $self = shift;
54    
55     # create handle
56 joko 1.3 if ( my $dsn = $self->{locator}->{dbi}->{dsn} ) {
57     #if ( my $dsn = $self->{locator}->{dsn} ) {
58 joko 1.2 $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
59    
60     # HACK:
61     # set errorhandler before actually calling DBI->connect
62     # in order to catch errors from the very beginning
63     #DBI->{HandleError} = $self->{dbi}->{HandleError};
64    
65     #use Data::Dumper; print Dumper($self->{dbi});
66    
67 jonen 1.4 eval {
68     $self->{COREHANDLE} = DBI->connect( $dsn, '', '', $self->{locator}->{dbi} );
69     if (!$self->{COREHANDLE}) {
70     $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr );
71     return;
72     }
73     };
74     $logger->warning( __PACKAGE__ . "->connect failed: " . $@ ) if $@;
75    
76 cvsjoko 1.1 }
77     $self->configureCOREHANDLE();
78 joko 1.3
79     $self->{locator}->{status}->{connected} = 1;
80    
81 joko 1.2 return 1;
82    
83 cvsjoko 1.1 }
84    
85     sub configureCOREHANDLE {
86    
87     my $self = shift;
88    
89 joko 1.3 $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" );
90 cvsjoko 1.1
91 joko 1.5 # apply configured modifications to DBI-handle
92 joko 1.3 if (exists $self->{locator}->{dbi}->{trace_level} && exists $self->{locator}->{dbi}->{trace_file}) {
93     $self->{COREHANDLE}->trace($self->{locator}->{dbi}->{trace_level}, $self->{locator}->{dbi}->{trace_file});
94 cvsjoko 1.1 }
95 joko 1.3 if (exists $self->{locator}->{dbi}->{RaiseError}) {
96     $self->{COREHANDLE}->{RaiseError} = $self->{locator}->{dbi}->{RaiseError};
97 cvsjoko 1.1 }
98 joko 1.3 if (exists $self->{locator}->{dbi}->{PrintError}) {
99     $self->{COREHANDLE}->{PrintError} = $self->{locator}->{dbi}->{PrintError};
100 cvsjoko 1.1 }
101 joko 1.3 if (exists $self->{locator}->{dbi}->{HandleError}) {
102     $self->{COREHANDLE}->{HandleError} = $self->{locator}->{dbi}->{HandleError};
103 cvsjoko 1.1 }
104    
105     }
106    
107     sub _sendSql {
108     my $self = shift;
109     my $sql = shift;
110 joko 1.2
111     # two-level handling for implicit connect:
112     # if there's no corehandle ...
113     if (!$self->{COREHANDLE}) {
114     # ... try to connect, but ...
115     $self->connect();
116     # ... if this still fails, there's something wrong probably, so we won't continue
117     if (!$self->{COREHANDLE}) {
118     return;
119     }
120     }
121    
122 joko 1.3 #print "prepare sql: $sql\n";
123    
124 cvsjoko 1.1 my $sth = $self->{COREHANDLE}->prepare($sql);
125     $sth->execute();
126     return $sth;
127     }
128    
129     sub sendCommand {
130     my $self = shift;
131     my $command = shift;
132 joko 1.5 # TODO: when tracing: yes, do actually log this
133 joko 1.2 #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" );
134 cvsjoko 1.1 my $cmdHandle = $self->_sendSql($command);
135     my $result = Data::Storage::Result::DBI->new( RESULTHANDLE => $cmdHandle );
136     return $result;
137     }
138    
139     sub getChildNodes {
140     my $self = shift;
141     my @nodes;
142 joko 1.3 $logger->debug( __PACKAGE__ . "->getChildNodes()" );
143 cvsjoko 1.1 if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
144 joko 1.3 my $dbname = getDbNameByDsn($self->{locator}->{dbi}->{dsn});
145     my $key = "Tables_in_$dbname";
146 joko 1.5 while ( my $row = $result->getNextEntry() ) {
147 joko 1.3 push @nodes, $row->{$key};
148 cvsjoko 1.1 }
149     }
150     return \@nodes;
151     }
152    
153 joko 1.5 sub getListUnfiltered {
154 cvsjoko 1.1 my $self = shift;
155 joko 1.5 my $nodename = shift;
156     my @list;
157     $logger->debug( __PACKAGE__ . "->getListUnfiltered( nodename => '" . $nodename . "' )" );
158     # get list of rows from rdbms by table name
159     my $result = $self->sendCommand("SELECT * FROM $nodename");
160     while ( my $row = $result->getNextEntry() ) {
161     push @list, $row;
162     }
163     return \@list;
164 cvsjoko 1.1 }
165    
166 joko 1.5 sub sendQuery {
167 cvsjoko 1.1 my $self = shift;
168 joko 1.5 my $query = shift;
169     #my $sql = "SELECT cs FROM $self->{metainfo}->{$descent}->{node} WHERE $self->{metainfo}->{$descent}->{IdentProvider}->{arg}='$self->{entry}->{source}->{ident}';";
170     #my $result = $self->{metainfo}->{$descent}->{storage}->sendCommand($sql);
171     my @crits;
172     foreach (@{$query->{criterias}}) {
173     my $op = '';
174     $op = '=' if lc $_->{op} eq 'eq';
175     push @crits, "$_->{key}$op'$_->{val}'";
176     }
177     my $subnodes = {};
178     map { $subnodes->{$_}++ } @{$query->{subnodes}};
179     # HACK: this is hardcoded ;( expand possibilities!
180     my $crit = join(' AND ', @crits);
181     my $sql = hash2Sql($query->{node}, $subnodes, 'SELECT', $crit);
182     return $self->sendCommand($sql);
183 joko 1.6 }
184    
185     sub eraseAll {
186     my $self = shift;
187     my $classname = shift;
188     my $sql = "DELETE FROM $classname";
189     $self->sendCommand($sql);
190 cvsjoko 1.1 }
191    
192 jonen 1.4 1;

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