/[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.7 - (hide annotations)
Sun Dec 1 07:09:09 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.6: +11 -1 lines
+ sub getListFiltered (dummy redirecting to getListUnfiltered)

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

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