lib/Stem/DBI.pm

   1 #  File: Stem/DBI.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   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.
  10
  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.
  15
  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
  19
  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:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 package Stem::DBI ;
  30
  31 use strict ;
  32
  33 use DBI ;
  34
  35 use base 'Stem::Cell' ;
  36 use Stem::Route qw( :cell ) ;
  37
  38
  39 my $attr_spec = [
  40
  41         {
  42                 'name'          => 'reg_name',
  43                 'help'          => <<HELP,
  44 HELP
  45         },
  46
  47         {
  48                 'name'          => 'port',
  49                 'help'          => <<HELP,
  50 HELP
  51         },
  52
  53         {
  54                 'name'          => 'host',
  55                 'help'          => <<HELP,
  56 HELP
  57         },
  58
  59         {
  60                 'name'          => 'db_type',
  61                 'required'      => 1,
  62                 'help'          => <<HELP,
  63 HELP
  64         },
  65
  66         # db_name must be something that can go after "dbi:mysql:" so
  67         # something like "dbname=foo" or "database=foo" depending on
  68         # the driver.
  69         {
  70                 'name'          => 'db_name',
  71                 'required'      => 1,
  72                 'help'          => <<HELP,
  73 HELP
  74         },
  75
  76         {
  77                 'name'          => 'user_name',
  78                 'env'           => 'dbi_user_name',
  79                 'help'          => <<HELP,
  80 HELP
  81         },
  82
  83         {
  84                 'name'          => 'password',
  85                 'env'           => 'dbi_password',
  86                 'help'          => <<HELP,
  87 HELP
  88         },
  89
  90         {
  91                 'name'          => 'dsn_extras',
  92                 'help'          => <<HELP,
  93 HELP
  94         },
  95
  96         {
  97                 'name'          => 'statements',
  98                 'help'          => <<HELP,
  99 HELP
 100         },
 101         {
 102                 'name'          => 'error_log',
 103                 'help'          => <<HELP,
 104 HELP
 105         },
 106
 107         {
 108                 'name'          => 'default_return_type',
 109                 'default'       => 'list_of_hashes',
 110                 'help'          => <<HELP,
 111 HELP
 112         },
 113         {
 114                 'name'          => 'cell_attr',
 115                 'class'         => 'Stem::Cell',
 116                 'help'          => <<HELP,
 117 This value is the attributes for the included Stem::Cell which handles
 118 cloning, async I/O and pipes.
 119 HELP
 120         },
 121 ] ;
 122
 123
 124 sub new {
 125
 126         my( $class ) = shift ;
 127
 128         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
 129         return $self unless ref $self ;
 130
 131         return "statements is not an ARRAY ref"
 132                         unless ref $self->{'statements'} eq 'ARRAY' ;
 133
 134         if ( my $err = $self->db_connect() ) {
 135
 136                 return $err ;
 137         }
 138
 139         if ( my $err = $self->prepare() ) {
 140
 141                 return $err ;
 142         }
 143
 144         $self->cell_worker_ready() ;
 145
 146         return $self ;
 147 }
 148
 149 sub db_connect {
 150
 151         my ( $self ) = @_ ;
 152
 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'} ;
 160
 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 ;
 165
 166 #print "DSN [$dsn]\n" ;
 167         my $dbh = DBI->connect( $dsn, $user_name, $password,
 168                                 { 'PrintError' => 0,
 169                                   'FetchHashKeyName' => 'NAME_lc' } )
 170             or return DBI->errstr ;
 171
 172         $self->{'dbh'} = $dbh ;
 173
 174         return ;
 175 }
 176
 177
 178 sub prepare {
 179
 180         my ( $self ) = @_ ;
 181
 182         my %name2statement ;
 183
 184         my $dbh = $self->{'dbh'} ;
 185
 186         my $statements = $self->{'statements'} ;
 187
 188         foreach my $statement ( @{$statements} ) {
 189
 190                 # Hey, this is ugly.  I guess we need parameter type
 191                 # coercion ;)
 192                 $statement = { @{$statement} };
 193                 my $name = $statement->{'name'} ;
 194
 195                 return "statement is missing a name" unless $name ;
 196
 197                 my $sql = $statement->{'sql'} ;
 198
 199                 return "statement '$name' is missing sql" unless defined $sql ;
 200
 201                 $statement->{'return_type'} ||= $self->{'default_return_type'};
 202
 203                 unless ( $self->can( $statement->{'return_type'} ) ) {
 204
 205                         return
 206                 "No such return type for $name: $statement->{'return_type'}";
 207                 }
 208
 209                 my $sth = $dbh->prepare( $sql )
 210                     or return $dbh->errstr ;
 211
 212                 $statement->{'sth'} = $sth ;
 213
 214                 $name2statement{ $name } = $statement ;
 215         }
 216
 217         $self->{'name2statement'} = \%name2statement ;
 218
 219         return ;
 220 }
 221
 222 sub execute_cmd {
 223
 224         my( $self, $msg ) = @_ ;
 225
 226 #print "EXEC\n" ;
 227
 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.
 230
 231         $self->cell_worker_ready() ;
 232
 233         my $data = $msg->data() ;
 234
 235         return $self->log_error( "No message data" )
 236                 unless $data ;
 237         return $self->log_error( "Message data is not a hash " )
 238                 unless ref $data eq 'HASH' ;
 239
 240         my $sth ;
 241         my $statement ;
 242
 243         if ( exists $data->{'sql'} ) {
 244
 245             return "Must provide return type" unless exists $data->{'return_type'} ;
 246
 247                 $statement = $data->{'sql'} ;
 248
 249             $sth = $self->{'dbh'}->prepare( $statement ) ;
 250
 251             return $self->log_error( $self->{'dbh'}->errstr . "\n$statement" )
 252                 if $self->{'dbh'}->errstr ;
 253         }
 254         else {
 255
 256             $statement = $data->{'statement'} ;
 257
 258             if ( my $in_cnt = $data->{'in_cnt'} ) {
 259
 260                     my $sql = $self->{'name2statement'}{$statement}{'sql'} ;
 261
 262                     my @qmarks = ('?') x $in_cnt ;
 263                     local( $" ) = ',' ;
 264                     $sql =~ s/IN\(\)/IN( @qmarks )/i ;
 265
 266                     $sth = $self->{'dbh'}->prepare( $sql ) ;
 267
 268                     return $self->log_error(
 269                                 $self->{'dbh'}->errstr . "\n$statement" )
 270                                         if $self->{'dbh'}->errstr ;
 271             }
 272             else {
 273
 274                     $sth = $self->{'name2statement'}{$statement}{'sth'} ;
 275                     return $self->log_error(
 276                             "Unknown statement name: $statement" ) unless $sth ;
 277             }
 278         }
 279
 280
 281         $self->{'statement'} = $statement ;
 282
 283         my $bind = $data->{'bind'} || [] ;
 284         return $self->log_error( "Statement arguments are not a list " )
 285                                  unless ref $bind eq 'ARRAY' ;
 286
 287         my $dbh = $self->{'dbh'} ;
 288
 289         my $return_type = $data->{'return_type'} ||
 290                 $self->{'name2statement'}{$statement}{'return_type'} ;
 291
 292         unless ( $self->can( $return_type ) ) {
 293
 294                 return $self->log_error(
 295                         "No such return type: $data->{'return_type'}" ) ;
 296         }
 297
 298         my $dbi_result = $self->$return_type( $sth, $bind ) ;
 299
 300         if ( $dbi_result && ! ref $dbi_result ) {
 301
 302                 return( $self->log_error( "[$statement] $dbi_result" ) ) ;
 303         }
 304
 305         return $dbi_result ;
 306 }
 307
 308 sub list_of_hashes {
 309
 310     return shift->_fetch( 'fetchall_arrayref', @_, {} );
 311 }
 312
 313 sub list_of_arrays {
 314
 315     return shift->_fetch( 'fetchall_arrayref', @_, [] );
 316 }
 317
 318 sub one_hashref {
 319
 320     return shift->_fetch( 'fetchrow_hashref', @_ );
 321 }
 322
 323 sub column_as_array {
 324
 325     my( $self, $sth, $bind ) = @_;
 326
 327     my @column;
 328
 329     $sth->finish if $sth->{'Active'} ;
 330
 331     $sth->execute( @{$bind} ) or return $sth->errstr ;
 332
 333     while ( my @row = $sth->fetchrow_array ) {
 334
 335         push @column, $row[0];
 336     }
 337
 338     return $sth->errstr() if $sth->errstr() ;
 339
 340     return \@column;
 341 }
 342
 343 sub _fetch {
 344
 345     my( $self, $method, $sth, $bind, @args ) = @_ ;
 346
 347     $sth->finish if $sth->{'Active'} ;
 348
 349     $sth->execute( @{$bind} ) or return $sth->errstr ;
 350
 351     my $data = $sth->$method( @args ) ;
 352
 353     return $sth->errstr if $sth->errstr ;
 354
 355     return $data ;
 356 }
 357
 358 sub rows_affected {
 359
 360     my( $self, $sth, $bind ) = @_;
 361
 362     $sth->execute( @{$bind} );
 363
 364     return $sth->errstr if $sth->errstr ;
 365
 366     return { 'rows' => $sth->rows };
 367 }
 368
 369 sub insert_id {
 370
 371     my( $self, $sth, $bind ) = @_;
 372
 373     my $err = $sth->execute( @{$bind} );
 374
 375     return $sth->errstr if $sth->errstr ;
 376
 377 #print "ID: [$self->{'dbh'}{'mysql_insertid'}]\n" ;
 378
 379     return { 'insert_id' => $self->{'dbh'}{'mysql_insertid'} } ;
 380 }
 381
 382 sub log_error {
 383
 384         my ( $self, $err ) = @_;
 385
 386         my $log = $self->{'error_log'} ;
 387
 388         return $err unless $log ;
 389
 390         Stem::Log::Entry->new (
 391                'logs'   => $log,
 392                'level'  => 5,
 393                'label'  => 'Stem::DBI',
 394                'text'   => "Statement: $self->{'statement'} - $err\n",
 395         ) ;
 396
 397         return \$err ;
 398 }
 399
 400 1 ;