/[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.5 - (hide annotations)
Fri Nov 29 05:00:26 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.4: +42 -38 lines
+ sub getListUnfiltered
+ sub sendQuery

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

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