3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
6 # Stem is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # Stem is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with Stem; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 # For a license to use the Stem under conditions other than those
21 # described here, to purchase support for this software, or to purchase a
22 # commercial warranty contract, please contact Stem Systems at:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
35 use base 'Stem::Cell' ;
36 use Stem::Route qw( :cell ) ;
66 # db_name must be something that can go after "dbi:mysql:" so
67 # something like "dbname=foo" or "database=foo" depending on
77 'name' => 'user_name',
78 'env' => 'dbi_user_name',
85 'env' => 'dbi_password',
91 'name' => 'dsn_extras',
97 'name' => 'statements',
102 'name' => 'error_log',
108 'name' => 'default_return_type',
109 'default' => 'list_of_hashes',
114 'name' => 'cell_attr',
115 'class' => 'Stem::Cell',
117 This value is the attributes for the included Stem::Cell which handles
118 cloning, async I/O and pipes.
126 my( $class ) = shift ;
128 my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
129 return $self unless ref $self ;
131 return "statements is not an ARRAY ref"
132 unless ref $self->{'statements'} eq 'ARRAY' ;
134 if ( my $err = $self->db_connect() ) {
139 if ( my $err = $self->prepare() ) {
144 $self->cell_worker_ready() ;
153 my $db_type = $self->{'db_type'} ;
154 my $db_name = $self->{'db_name'} ;
155 my $host = $self->{'host'} ;
156 my $port = $self->{'port'} ;
157 my $user_name = $self->{'user_name'} ;
158 my $password = $self->{'password'} ;
159 my $extras = $self->{'dsn_extras'} ;
161 my $dsn = "dbi:$db_type:$db_name" ;
162 $dsn .= ";host=$host" if defined $host ;
163 $dsn .= ";port=$port" if defined $port ;
164 $dsn .= ";$extras" if defined $extras ;
166 #print "DSN [$dsn]\n" ;
167 my $dbh = DBI->connect( $dsn, $user_name, $password,
169 'FetchHashKeyName' => 'NAME_lc' } )
170 or return DBI->errstr ;
172 $self->{'dbh'} = $dbh ;
184 my $dbh = $self->{'dbh'} ;
186 my $statements = $self->{'statements'} ;
188 foreach my $statement ( @{$statements} ) {
190 # Hey, this is ugly. I guess we need parameter type
192 $statement = { @{$statement} };
193 my $name = $statement->{'name'} ;
195 return "statement is missing a name" unless $name ;
197 my $sql = $statement->{'sql'} ;
199 return "statement '$name' is missing sql" unless defined $sql ;
201 $statement->{'return_type'} ||= $self->{'default_return_type'};
203 unless ( $self->can( $statement->{'return_type'} ) ) {
206 "No such return type for $name: $statement->{'return_type'}";
209 my $sth = $dbh->prepare( $sql )
210 or return $dbh->errstr ;
212 $statement->{'sth'} = $sth ;
214 $name2statement{ $name } = $statement ;
217 $self->{'name2statement'} = \%name2statement ;
224 my( $self, $msg ) = @_ ;
228 # why not tell the queue ready before we start this operation. since
229 # it blocks we will handle that new work until this is done.
231 $self->cell_worker_ready() ;
233 my $data = $msg->data() ;
235 return $self->log_error( "No message data" )
237 return $self->log_error( "Message data is not a hash " )
238 unless ref $data eq 'HASH' ;
243 if ( exists $data->{'sql'} ) {
245 return "Must provide return type" unless exists $data->{'return_type'} ;
247 $statement = $data->{'sql'} ;
249 $sth = $self->{'dbh'}->prepare( $statement ) ;
251 return $self->log_error( $self->{'dbh'}->errstr . "\n$statement" )
252 if $self->{'dbh'}->errstr ;
256 $statement = $data->{'statement'} ;
258 if ( my $in_cnt = $data->{'in_cnt'} ) {
260 my $sql = $self->{'name2statement'}{$statement}{'sql'} ;
262 my @qmarks = ('?') x $in_cnt ;
264 $sql =~ s/IN\(\)/IN( @qmarks )/i ;
266 $sth = $self->{'dbh'}->prepare( $sql ) ;
268 return $self->log_error(
269 $self->{'dbh'}->errstr . "\n$statement" )
270 if $self->{'dbh'}->errstr ;
274 $sth = $self->{'name2statement'}{$statement}{'sth'} ;
275 return $self->log_error(
276 "Unknown statement name: $statement" ) unless $sth ;
281 $self->{'statement'} = $statement ;
283 my $bind = $data->{'bind'} || [] ;
284 return $self->log_error( "Statement arguments are not a list " )
285 unless ref $bind eq 'ARRAY' ;
287 my $dbh = $self->{'dbh'} ;
289 my $return_type = $data->{'return_type'} ||
290 $self->{'name2statement'}{$statement}{'return_type'} ;
292 unless ( $self->can( $return_type ) ) {
294 return $self->log_error(
295 "No such return type: $data->{'return_type'}" ) ;
298 my $dbi_result = $self->$return_type( $sth, $bind ) ;
300 if ( $dbi_result && ! ref $dbi_result ) {
302 return( $self->log_error( "[$statement] $dbi_result" ) ) ;
310 return shift->_fetch( 'fetchall_arrayref', @_, {} );
315 return shift->_fetch( 'fetchall_arrayref', @_, [] );
320 return shift->_fetch( 'fetchrow_hashref', @_ );
323 sub column_as_array {
325 my( $self, $sth, $bind ) = @_;
329 $sth->finish if $sth->{'Active'} ;
331 $sth->execute( @{$bind} ) or return $sth->errstr ;
333 while ( my @row = $sth->fetchrow_array ) {
335 push @column, $row[0];
338 return $sth->errstr() if $sth->errstr() ;
345 my( $self, $method, $sth, $bind, @args ) = @_ ;
347 $sth->finish if $sth->{'Active'} ;
349 $sth->execute( @{$bind} ) or return $sth->errstr ;
351 my $data = $sth->$method( @args ) ;
353 return $sth->errstr if $sth->errstr ;
360 my( $self, $sth, $bind ) = @_;
362 $sth->execute( @{$bind} );
364 return $sth->errstr if $sth->errstr ;
366 return { 'rows' => $sth->rows };
371 my( $self, $sth, $bind ) = @_;
373 my $err = $sth->execute( @{$bind} );
375 return $sth->errstr if $sth->errstr ;
377 #print "ID: [$self->{'dbh'}{'mysql_insertid'}]\n" ;
379 return { 'insert_id' => $self->{'dbh'}{'mysql_insertid'} } ;
384 my ( $self, $err ) = @_;
386 my $log = $self->{'error_log'} ;
388 return $err unless $log ;
390 Stem::Log::Entry->new (
393 'label' => 'Stem::DBI',
394 'text' => "Statement: $self->{'statement'} - $err\n",