package SPOPS::SQLInterface; # $Id: SQLInterface.pm,v 3.12 2004/06/02 00:48:21 lachoy Exp $ use strict; use Data::Dumper qw( Dumper ); use DBI; use Log::Log4perl qw( get_logger ); use SPOPS::DBI::TypeInfo; use SPOPS::Exception qw( spops_error ); use SPOPS::Exception::DBI qw( spops_dbi_error ); my $log = get_logger(); $SPOPS::SQLInterface::VERSION = sprintf("%d.%02d", q$Revision: 3.12 $ =~ /(\d+)\.(\d+)/); my %TYPE_INFO = (); sub throw_no_database_handle_error { my ( $item ) = @_; my $class = ref $item || $item; spops_error "No database handle available; pass using the 'db' ", "parameter or define ${class}->global_datasource_handle ", "to return a valid DBI handle."; } # Drivers that don't support the two-argument form of DBI->quote # should override... sub sql_quote { my ( $class, $value, $type, $db ) = @_; return 'NULL' unless ( defined $value ); $db ||= $class->global_datasource_handle; unless ( ref $db ) { spops_error "No database handle could be found!"; } # This issues a warning when '$type' is unknown; need to figure # out how to set '$type' to a known value return $db->quote( $value, $type ); } # Note: not sure how to integrate the fieldtype discovery # stuff in here. What if you do: # # select u.username from users u, logins l # where l.login_date > ? and # l.user_id = u.user_id # # and pass '2000/1/13' is passed in? This seems to be a little # too much in-depth sql processing than this library is # appropriate for; so you can still pass in values for binding, # but they'll all be bound with SQL_VARCHAR # # select => \@ of fields to select # select_modifier => $ to insert between 'SELECT' and fields (e.g., DISTINCT) # from => \@ of tables to select from ($ allowed if only one) # order => $ clause to order by # group => $ clause to group by # where => $ clause to limit results # return => sth | single | list | hash | single-list # value => \@ of values to bind, all as SQL_VARCHAR; they must match order of '?' in where # sql => $ statement to execute sub db_select { my ( $class, $p ) = @_; my $db = $p->{db} || $class->global_datasource_handle; $class->throw_no_database_handle_error unless ( $db ); # Don't do anything if the SQL isn't passed in and you don't have # either a list of fields to select or a table to select them from unless ( $p->{sql} or ( $p->{select} and $p->{from} ) ) { spops_error 'Cannot run without select/from statements!'; } $log->is_debug && $log->debug( "Entering db_select with ", Dumper( $p ) ); $p->{return} ||= 'list'; $p->{value} ||= []; my $sql = $p->{sql}; # If we don't have any SQL, build it (straightforward). unless ( $sql ) { $log->is_info && $log->info( "No SQL passed in to execute directly; building." ); $p->{from} ||= $p->{table}; # allow an alias if ( $p->{from} and ref $p->{from} ne 'ARRAY' ) { $p->{from} = [ $p->{from} ]; } $p->{select_modifier} ||= ''; my $select = join ', ', @{ $p->{select} }; my $from = join ', ', @{ $p->{from} }; my $order = ( $p->{order} ) ? "ORDER BY $p->{order}" : ''; my $where = ( $p->{where} ) ? "WHERE $p->{where}" : ''; my $group = ( $p->{group} ) ? "GROUP BY $p->{group}" : ''; $sql = qq/ SELECT $p->{select_modifier} $select FROM $from $where $group $order /; } $log->is_info && $log->info( "SQL for select: $sql" ); # First prepare and check for errors... my $sth = eval { $db->prepare( $sql ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, action => 'prepare' }; } # Execute with any bound parameters; note that for Sybase you do # not need to pass any types at all. $log->is_info && $log->info( "Values bound: ", join( '//', @{ $p->{value} } ) ); eval { $sth->execute( @{ $p->{value} } ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, bound_value => $p->{value}, action => 'execute' }; } # If they asked for the handle back, give it to them if ( $p->{return} eq 'sth' ) { $log->is_info && $log->info( "Returning statement handle (after prepare/execute)" ); return $sth; } # If they asked for a single row, return it in arrayref format [ # field1, field2, ...] if ( $p->{return} eq 'single' ) { $log->is_info && $log->info( "Returning single row." ); my $row = eval { $sth->fetchrow_arrayref; }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, bound_value => $p->{value}, action => 'fetchrow_arrayref' }; } return $row; } # If they asked for a list of results, return an arrayref of arrayrefs elsif ( $p->{return} eq 'list' ) { $log->is_info && $log->info( "Returning list of lists." ); my $rows = eval { $sth->fetchall_arrayref; }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, bound_value => $p->{value}, action => 'fetchall_arrayref' }; } return $rows; } # return the first element of each record in an arrayref elsif ( $p->{return} eq 'single-list' ) { $log->is_info && $log->info( "Returning list of single items." ); my $rows = eval { $sth->fetchall_arrayref }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, bound_value => $p->{value}, action => 'fetchall_arrayref' }; } return [ map { $_->[0] } @{ $rows } ]; } # If they asked for a hash, return a list of hashrefs elsif ( $p->{return} eq 'hash' ) { $log->is_info && $log->info( "Returning list of hashrefs." ); my @rows = (); # Note -- we may need to change this to zip through $row every # time and push a new reference onto @rows eval { while ( my $row = $sth->fetchrow_hashref ) { push @rows, \%{ $row }; } }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, bound_value => $p->{value}, action => 'fetchall_arrayref' }; } return \@rows; } return []; } # field => \@ of fieldnames # value => \@ of values # table => $ of table to insert into # no_quote => \% of fields not to quote # sql => $ of sql to run # return_sth => $ if true, return the statement handle rather than status sub db_insert { my ( $class, $p ) = @_; my $db = $p->{db} || $class->global_datasource_handle; $class->throw_no_database_handle_error unless ( $db ); $log->is_debug && $log->debug( "Enter insert procedure\n", Dumper( $p ) ); # If we weren't given direct sql or a list of values or table, bail unless ( $p->{sql} or ( $p->{value} and $p->{table} ) ) { spops_error 'Cannot continue with no SQL, values or table name'; } my $sql = $p->{sql}; # If we weren't given SQL, build it. unless ( $sql ) { # Find the types for all fields in this table (we don't have # to use them all...); let any errors trickle up my $type_info = $class->db_discover_types( $p->{table}, { dbi_type_info => $p->{dbi_type_info}, db => $db }); my ( $fields, $values ); # Be sure these are at least empty hashrefs, otherwise we # will get an error $p->{no_quote} ||= {}; $p->{field} ||= []; $p->{value} ||= []; $log->is_debug && $log->debug( "Fields/values: ", Dumper( $p->{field}, $p->{value} ) ); # Cycle through the fields and values, creating lists # suitable for join()ing into the SQL statement. my @value_list = (); my $count = 0; foreach my $field ( @{ $p->{field} } ) { next unless ( $field ); # Quote the value unless the user asked us not to my $value = ( $p->{no_quote}{ $field } ) ? $p->{value}->[ $count ] : $class->sql_quote( $p->{value}->[ $count ], $type_info->get_type( $field ), $db ); $log->is_info && $log->info( "Trying to add quoted value [$value] ", "for field [$field]" ); push @value_list, $value; $count++; } my $field_listing = join ', ', @{ $p->{field} }; my $value_listing = join ', ', @value_list; $sql = qq/ INSERT INTO $p->{table} ( $field_listing ) VALUES ( $value_listing ) /; } # Note that we use the prepare()/execute() method of # getting this data in rather than the simpler do(), # since the user might want the statement handle afterward; # if this becomes a performance hang (doubtful), we can only # do p/e if the user's asked for the statement handle $log->is_info && $log->info( "Preparing\n$sql" ); my $sth = eval { $db->prepare( $sql ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, action => 'prepare' }; } my $rv = eval { $sth->execute }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, action => 'execute' }; } $log->is_info && $log->info( "Prepare/execute went ok." ); # Everything is ok; return either a true value # or the statement handle, if they've asked for it. return $sth if ( $p->{return_sth} ); return $rv; } # field => \@ of fieldnames # value => \@ of values (includes both update values and WHERE params) # table => $ of table to insert into # where => $ clause for which we're updating # no_quote => \% of fields not to quote # sql => $ of sql to run sub db_update { my ( $class, $p ) = @_; my $db = $p->{db} || $class->global_datasource_handle; $class->throw_no_database_handle_error unless ( $db ); # If we weren't given direct sql or a list of values or table, bail unless ( $p->{sql} or ( $p->{value} and $p->{table} ) ) { spops_error 'Cannot continue with no SQL, values or table name'; } my $sql = $p->{sql}; my @values = (); $p->{value} ||= []; # If SQL provided still pass the values as bound parameters if ( $sql ) { @values = @{ $p->{value} }; } # Build the SQL unless ( $sql ) { # Find the types for all fields in this table (we don't have # to use them all...); let the error trickle up my $type_info = $class->db_discover_types( $p->{table}, { dbi_type_info => $p->{dbi_type_info}, db => $db } ); my ( @update ); # make a copy of the values given so we can modify the list as # we go -- it may include both update parameters and WHERE # parameters @values = @{ $p->{value} }; # Go through each field and setup an update assign subset # for each; most of them get a bound parameter and push the # value onto the stack, but values that cannot be bound push # the direct information onto the stack. $p->{no_quote} ||= {}; foreach my $field ( @{ $p->{field} } ) { my $rawval = shift @values; $log->is_info && $log->info( "Trying to add value [", defined $rawval ? $rawval : '', "] ", "with field [$field] and type ", "[", $type_info->get_type( $field ), "]" ); # Quote the value unless the user asked us not to my $value = ( $p->{no_quote}{ $field } ) ? $rawval : $class->sql_quote( $rawval, $type_info->get_type( $field ), $db ); push @update, "$field = $value"; } my $update = join ', ', @update; my $where = ( $p->{where} ) ? "WHERE $p->{where}" : ''; $sql = qq/ UPDATE $p->{table} SET $update $where /; } $log->is_info && $log->info( "Prepare/execute\n$sql" ); my $sth = eval { $db->prepare( $sql ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, action => 'prepare' }; } # assign the remainder of the values in case the 'WHERE' clause # included any my $rv = eval { $sth->execute( @values ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, action => 'execute' }; } return $rv; } # table => $ of table we're deleting from # where => $ limiting our deletes # value => \@ of values to bind # sql => $ of statement to execute directly sub db_delete { my ( $class, $p ) = @_; my $db = $p->{db} || $class->global_datasource_handle; $class->throw_no_database_handle_error unless ( $db ); # Gotta have a table to delete from unless ( $p->{table} or $p->{sql} ) { spops_error 'Cannot delete records without SQL or a table name'; } # If we weren't given SQL, build it. my $sql = $p->{sql}; unless ( $sql ) { # Hopefully you'll have a WHERE clause... but we'll let # you shoot yourself in the foot if you forget :) my $where = ( $p->{where} ) ? "WHERE $p->{where}" : ''; $sql = qq/ DELETE FROM $p->{table} $where /; } $log->is_info && $log->info( "SQL for DELETE:\n$sql" ); $p->{value} ||= []; my $sth = eval { $db->prepare( $sql ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, action => 'prepare' }; } my $rv = eval { $sth->execute( @{ $p->{value} } ) }; if ( $@ ) { spops_dbi_error $@, { sql => $sql, bound_value => $p->{value}, action => 'execute' }; } return $rv; } sub db_discover_types { my ( $class, $table, $p ) = @_; # Create the index used to find the table info later my $db = $p->{db} || $class->global_datasource_handle; $class->throw_no_database_handle_error unless ( $db ); my $db_name = eval { $db->{Name} } || eval { $db->{name} }; my $type_idx = join( '-', lc $db_name , lc $table ); $log->is_debug && $log->debug( "Type index used to discover data types: [$type_idx]" ); # If we've already discovered the types, get the cached copy return $TYPE_INFO{ $type_idx } if ( $TYPE_INFO{ $type_idx } ); my $type_info = SPOPS::DBI::TypeInfo->new({ database => $db_name, table => $table }); my $conf = eval { $class->CONFIG }; my $fake_types = $p->{dbi_type_info} || $conf->{dbi_type_info}; # Certain databases (or more specifically, DBD drivers) do not # process $sth->{TYPE} requests properly, so we need the user to # specify the types by hand if ( ref $fake_types eq 'HASH' ) { while ( my ( $field, $fake_type ) = each %{ $fake_types } ) { $type_info->add_type( $field, $fake_type ); } } # Otherwise, fetch the types from the database else { my $sql = $class->sql_fetch_types( $table ); $type_info->fetch_types( $db, $sql ); } return $TYPE_INFO{ $type_idx } = $type_info } # Default data type discovery statement sub sql_fetch_types { return "SELECT * FROM $_[1] where 1 = 0" } 1; __END__ =pod =head1 NAME SPOPS::SQLInterface - Generic routines for DBI database interaction =head1 SYNOPSIS # Make this class a parent of my class package My::DBIStuff; use SPOPS::SQLInterface; @My::DBIStuff::ISA = qw( SPOPS::SQLInterface ); # You should also be able to use it directly, but you # need to pass in a database object with every request use SPOPS::SQLInterface; my $dbc = 'SPOPS::SQLInterface'; my $db = DBI->connect( ... ) || die $DBI::errstr; my $rows = $dbc->db_select({ select => [ qw/ uid first_name last_name / ], from => [ 'users' ], where => 'first_name = ? or last_name = ?', value => [ 'fozzie', "th' bear" ], db => $db }); foreach my $row ( @{ $results } ) { print "User ID $row->[0] is $row->[1] $row->[2]\n"; } =head1 DESCRIPTION You are meant to inherit from this class, although you can use it as a standalone SQL abstraction tool as well, as long as you pass the database handle into every routine you call. =head1 DATABASE METHODS Relatively simple methods to do the select, update, delete and insert statements, with the right values and table names being passed in. All parameters are passed in via named values, such as: $t->db_select({ select => [ 'this', 'that' ], from => [ 'mytable' ] }); B The subclass that uses these methods must either pass in a DBI database handle via a named parameter (B) or make it available through a method of the class called 'global_datasource_handle'. =head1 METHODS There are very few methods in this class, but each one can do quite a bit. =head2 sql_quote( $value, $type, $db ) Quotes a value for insertion/update or selection when bound parameters are inappropriate or unavailable. Returns 'NULL' if C<$value> is undef, otherwise calls C on the DBI handle C<$db>. Drivers that do not implement the two-argument form of C should override this method. Returns: quoted C<$value> appropriate to use in a SQL statement =head2 db_select( \%params ) Executes a SELECT. Return value depends on what you ask for. Many of the parameters are optional unless you pass in SQL to execute. Parameters: B ($) (optional) Full statement to execute, although you may put '?' in the where clause and pass values for substitution. (No quoting hassles...) B