File Coverage

blib/lib/DBIx/SimplePerl.pm

Criterion	Covered	Total	%
statement	33	421	7.8
branch	0	252	0.0
condition	0	30	0.0
subroutine	11	29	37.9
pod	7	14	50.0
total	51	746	6.8

package DBIx::SimplePerl;

use base qw(Class::Accessor);

use 5.008;
use strict;
use warnings;
no strict "subs";
no strict "refs";
use DBI;
use POSIX qw(strftime ceil);
use Data::Dumper;

use constant true 	=> (1==1);
use constant false 	=> (1==0);

our $VERSION = '1.95';


# Preloaded methods go here.
=pod
=head1 NAME

DBIx::SimplePerl - Perlish access to DBI

=head1 ABSTRACT


This module provides DBIx::SimplePerl which is a highly (over)simplified
interface to DBI.  The point of DBIx::SimplePerl is that end programmers
who  want to write their programs which access simple databases in
Perl, should be able to write their programs in Perl and not Perl +
SQL.  This is a different approach as compared to the Tie::DBI.
This module is not what high end or midrange database programmers
would like or care to use.  It works great for really simple stuff,
like SADU (search, add, delete,  update) on existing tables.  It
follows a basic Keep It Simple(tm) philosophy, in that the
programmer ought to be able to use a database table with very
little effort.  Other modules attempt to make SQL access simple, but
in the end they rely on the user emitting SQL at some point.  This
module hides the SQL from the end user by automatically generating it
in flight.  The idea being that Perl programmers who need very simple
database access do not necessarily need to write SQL.

=head1 SYNOPSIS

  # Brackets [] represent optional items, not array indices.
  # Elipses ... mean more of the same inputs/options

  use DBIx::SimplePerl;
  my $sice = DBIx::SimplePerl->new;

  ...
  # all methods return a hash with two possible keys.
  # On success, the return is
  #	{ success => true }
  # On failure, the return is
  #	{ failed  => {
  #                    error => "error_message_from_call",
  #                    code  => "error_return_code_from_call"
  #                  }
  #     }

  # sets internal $sice->{_dbh} to open database handle
  $sice->db_open(
  		 dsn => $dsn,
		 dbuser => $dbuser,
		 dbpass => $dbpass,
  		 [AutoCommit => 0|1,]
		 [RaiseError => 0|1 ]
		 ...
		);

  $sice->db_add(
                table 	=> $table_name,
		columns => {
			    field1	=> $data1,
			    [field2	=> $data2,]
			    [...]
			   }
               );

  $sice->db_search(
  		   table => $table_name,
		  [search => {
			      field1=>$data1,
			     [field2=>@array2]
					 ...
			     }],
                 [ search_operator => 'AND' | 'OR' ]
 		 [ count 	=>  field ],
		 [ max   	=>  field ],
		 [ min   	=>  field ],
                 [ distinct     => { field1,
		 		     [field2], ... ]
				    } ],

		 [ columns 	=>  { field1,
		 		     [field2], ... ]
				    } ],
 		 [ order  =>  fieldN]
		  );

  $sice->db_update(
  		   table => $table_name,
		   search => {
		   	      field	=> $data1,
			      [field2	=> $data2,]
			      ...
			     },
		   columns=> {
			      field1	=> $data1,
			      ...
	  		     }
	          );

  $sice->db_commit;

  $sice->db_delete(
  		   table => $table_name,
		   search => {
		   	      field	=> $data1,
			      ...
			     }
		  );

  # db_next returns the next row as a hash ref
  my $x;
  while ($x=$sice->db_next )
   {
     map { printf "key = %s, value =\'%s\'\n",$_,$x{$_} } keys %{$x};
   }

  # db_array returns all the rows as an array of hash refs
  my $x;
  foreach $x (@{$sice->db_array })
   {
     map { printf "key = %s, value =\'%s\'\n",$_,$x{$_} } keys %{$x};
   }



  $sice->db_trace(level => $number);	# turn on DBI tracing
  $sice->db_rows;			# return rows affected by session handle
  					# note that DBI documentation indicates
					# that the rows method upon which this is
					# based is effectively useless.
  $rc=$sice->db_ping;			# perform a db_ping call
  $sice->{debug} = 1 ; # turn on debugging
  $sice->{debug} = 0 ; # turn off debugging
  $sice->db_rollback;  # roll back a transaction


  # quoting for table, field, and value is set by default
  # you can override it during or after creating the object.
  $sice->{quote}->{table} = '"';
  $sice->{quote}->{field} = '"';
  $sice->{quote}->{value} = '"';

  # SQLite, Postgres, and MySQL are supported, with default
  # quoting assumed for others.  You can change this as needed.

  $sice->db_close;

The session handle is available under the object as $sice->{_sth}

=head2 Methods

=over 4

=item db_open(dsn => $dsn, dbuser => $dbuser, dbpass => $dbpass  )

The C method returns a database handle attached to
$self->{_dbh}.  RaiseError defaults to 0 and AutoCommit defaults
to 1.  This function attaches the object to a database.
As long as the DBD/DBI supports it, you may have multiple
independent objects connected to the same database.

=item db_add(table => $table_name,columns => {field1=>$data1,...})

The C method will take a record (the hash pointed to by
the columns field, generate the necessary SQL, and do an insert into
the table indicated.  That is, if we have a table named "users", and
we want to add a record with a username, password, home directory,
and shell, we can do something like this:

    use DBIx::SimplePerl;
    my $sice = DBIx::SimplePerl->new;
    $sice->db_open(
                    'dsn'    => "dbi:SQLite:dbname=/etc/cluster/cluster.db",
                    'dbuser' => "",
                    'dbpass' => ""
                  );

    $sice->db_add(
    		   table   =>"users",
		   columns => {
		   		username	=> $username,
				password	=> $password,
				homedir		=> $homedir,
				shell		=> $shell
		   	      }
		 );

and the method will generate the appropriate SQL to insert this
record:

   insert into "users" ("username","password","homedir","shell") \
   values ("$username","$password","$homedir","$shell");

If the insert operation failed or generated errors or warnings, you
will be able to check for the existence of and inspect $sice->{failed}.
As each DBD is different, no two different DBDs will generate the same
error messages or error codes.

If you would like to see the SQL the method generates, then set
the debug attribute to a non-zero value

  $sice->{debug} = 1;

and it will emit the SQL it generates on the STDERR.

=item db_search(table => $table_name,search => {field1=>$data1,...})

The C method will perform a select with an
appropriate where clause, generated by the hash pointed to by
the search field.  That is, if we have a table named "users", and
we want to find a set of one or more records with a particular
username, we can do something like this:

    use DBIx::SimplePerl;
    my $sice = DBIx::SimplePerl->new;
    $sice->db_open(
                    'dsn'    => "dbi:SQLite:dbname=/etc/cluster/cluster.db",
                    'dbuser' => "",
                    'dbpass' => ""
                  );

    $sice->db_search(
    		   table   =>"users",
		   search => { username => $username }
		 );

and the method will generate the appropriate SQL to perform this
select:

   select from "users" where "username"="$username";

If you provide an array to the search field (username in this example)
the module will do the right thing and generate

   select from "users" where "username" in ( "@{$username}[0]" ,
   "@{$username}[1]" , ... , "@{$username}[N]");

So if you performed this call like this:

    $sice->db_search(
    		   table	=>"users",
		   search 	=> {
		   		    username => [
				    		 "Tom",
						 "Dick",
						 "Harry"
						]
				   }
		 );

the module will generate the query as

   select from "users" where "username" in ("Tom", "Dick", "Harry");

This functionality is not yet in other methods than the search module.
This may change in future releases.

Also, if you want to return only some of the columns in the database,
you could use the columns => "comma,separated,list,of,columns,to,return"
option

    $sice->db_search(
    		   table	=>"users",
		   search 	=> {
		   		    username => [
				    		 "Tom",
						 "Dick",
						 "Harry"
						]
				   },
		   columns	=> "name,date,uid,homedir"
		 );

And if you wanted to pre-order the output records, use the order=>field
option

    $sice->db_search(
    		   table	=>"users",
		   search 	=> {
		   		    username => [
				    		 "Tom",
						 "Dick",
						 "Harry"
						]
				   },
		   columns	=> "name,date,uid,homedir",
		   order	=> "uid"
		 );

or

    $sice->db_search(
    		   table	=>"users",
		   search 	=> {
		   		    username => [
				    		 "Tom",
						 "Dick",
						 "Harry"
						]
				   },
		   order	=> "uid"
		 );



If the select operation failed or generated errors or warnings, you
will be able to check for the existence of and inspect
$sice->{failed}->{error} and if the DBD developer provided an error
code, it would be in $sice->{failed}->{code}.  As each DBD is
different, no two different DBDs will generate the same error
messages or error codes.

As many fields as are relevant in the  particular table may be used.  The
search=> may be completely omitted  to give a "SELECT * from table"
effect.  The results are returned as a DBI session handle within the
object instance.  To extract the data, use the db_next method.

while ($sice->db_next)
 {
  # do something with the $_ hashref to the query results
 }

or if you prefer dealing with arrays, you can use a foreach with
db_array

foreach (@$sice->db_array)
 {
  # do something with the $_ hashref to the query results
 }

If the select succeeds, then the $sice->db_search... will
return an anonymous hash with a key named "success".  Testing
for the existence of this key is sufficent for determining if the
method call succeeded.  Error messages (if generated) would be
stored in the anonymous hash's "failed" key.  Lack of existence of
this key is another indicator of success.  There is more than one
way to do it, and these should always be consistent.

Of course though, they are not (yet) consistent.  DBI returns

	function(column) => 'value'

for the min, max, and count functions.  So if you do a search for the
maximum of a set of columns

   $sice->db_search(
    		     table	=> "users",
		     max 	=> "uid"
		   );

then when you query the returned results, be aware that they will
show up as

	'max(uid)'	=> value

using the hashrefs.  Since you don't care about the key, you can
extract the first value.

	$max	= (values %{$sice->db_next} )[0];

This is somewhat convoluted, so assume that this interface will change.


=item db_update( table => $table_name,
                 search => {field1=>$data1,...},
		 columns=> {field1=>$data1,...});


The C method will perform an update with an
appropriate where clause, generated by the hash pointed to by
the search field, using the column hash to insert the updated
values.  Fields not specified in the column hash will not be
changed.  That is, if we have a table named "users", and
we want to update a set of one or more records with a particular
username, we can do something like this:

    use DBIx::SimplePerl;
    my $sice = DBIx::SimplePerl->new;
    $sice->db_open(
		  'dsn'    => "dbi:SQLite:dbname=/etc/cluster/cluster.db",
		  'dbuser' => "",
	          'dbpass' => ""
                  );

    $sice->db_update(
    		   table   =>"users",
		   search  => { username => $username    },
		   columns => { homedir  => $new_homedir }
		 );

and the method will generate the appropriate SQL to perform this
update.:

   update  "users" set "homedir"="$new_homedir" \
                   where "username"="$username";

If the update operation failed or generated errors or warnings, you
will be able to check for the existence of and inspect $sice->{error}.
As many fields as are relevant in the particular table may be used
in the search hash or the column hash.  The results are returned as
a DBI session handle, and any of the DBI methods may be used to
extract the data at this point.

If the update succeeds, then the $sice->db_update... will
return an anonymous hash with a key named "success".  Testing
for the existence of this key is sufficent for determining if the
method call succeeded.  Error messages (if generated) would be
stored in the anonymous hash's "failed" key.  Lack of existence of
this key is another indicator of success.


=item db_commit

The C method will perform an explicit commit on the
db handle.  This is useful when AutoCommit is set to 0.  Note that
this means that if you disconnect on an AutoCommit => 0 db before
doing a db_close, that your state changes will likely be lost.

B

You would need to perform the db_commit after some group of operations
on an AutoCommit => 0 to insure that they are in fact committed to
disk.  If AutoCommit => 0, this is entirely your responsibility.
Turning off AutoCommit can speed things up tremendously, though
it will do it at the expense of granularity.  Your changes will be
much larger grained.  This is why we default to AutoCommit => 1, so
you do not need to think about this for most cases.

If the commit operation failed or generated errors or warnings, you
will be able to check for the existence of and inspect $sice->{error}.

=item db_delete(table => $table_name, search => {field1=>$data1,...})


The C method will perform a record delete with an
appropriate where clause, generated by the hash pointed to by
the search field.  This will not delete the table itself, just the
record.  That is, if we have a table named "users", and
we want to delete a set of one or more records with a particular
username, we can do something like this:

    use DBIx::SimplePerl;
    my $sice = DBIx::SimplePerl->new;
    $sice->db_open(
                    'dsn'    => "dbi:SQLite:dbname=/etc/cluster/cluster.db",
                    'dbuser' => "",
                    'dbpass' => ""
                  );

    $sice->db_delete(
    		   table   =>"users",
		   search  => {
		   		username => $username
		   	      }
		 );

and the method will generate the appropriate SQL to perform this
update.:

   delete from "users" where "username"="$username";

Note that if more than one field is used in the search, the fields
will use as the conditional, in order,

1) $sice->{search_conditional} (with values of "AND", "OR", or any other
SQL accepted operator for delete statements.

2) "AND" which is the default unless overridden in this object by point 1.

This allows you to have

    $sice->db_delete(
                   table   =>"users",
                   search  => {
                                username => $username,
				dir	 => $dir
                              }
                 );

become (by default)

   delete from "users" where "username"="$username" AND "dir"=$dir;



If the delete operation failed or generated errors or warnings, you
will be able to check for the existence of and inspect $sice->{error}.
As many fields as are relevant in the particular table may be used
in the search hash.  The results are returned as
a DBI session handle, and any of the DBI methods may be used to
extract the data at this point.

If the delete succeeds, then the $sice->db_update... will
return an anonymous hash with a key named "success".  Testing
for the existence of this key is sufficent for determining if the
method call succeeded.  Error messages (if generated) would be
stored in the anonymous hash's "failed" key.  Lack of existence of
this key is another indicator of success.

=item db_create_table(table => $table_name,columns => {field1=>"type1",...})

The C method will take a record (the hash pointed to by
the columns field, generate the necessary SQL, and do an create table into
the attached database handle.  That is, if we want to create a table
named "users", with columns of username, password, home directory, uid,
shell, and date we can do something like this:

    use DBIx::SimplePerl;
    my $sice = DBIx::SimplePerl->new;
    $sice->db_open(
                    'dsn'    => "dbi:SQLite:dbname=/etc/cluster/cluster.db",
                    'dbuser' => "",
                    'dbpass' => ""
                  );

    $sice->db_create_table(
    		   table   =>"users",
		   columns => {
		   		username	=> "varchar(30)",
				password	=> "varchar(30)",
				homedir		=> "varchar(255)",
				shell		=> "varchar(30)",
				uid		=> "integer",
				date		=> "datetime"
		   	      }
		 );

and the method will generate the appropriate SQL to create this
table:

   create table "users"
   	(
	  "username"	varchar(30),
	  "password"	varchar(30),
	  "homedir"	varchar(255) ,
	  "shell"	varchar(30),
	  "uid"		integer,
	  "date"	datetime
	);

If the create operation failed or generated errors or warnings, you
will be able to check for the existence of and inspect $sice->{failed}.
As each DBD is different, no two different DBDs will generate the same
error messages or error codes.

If you would like to see the SQL the method generates, then set
the debug attribute to a non-zero value

  $sice->{debug} = 1;

and it will emit the SQL it generates on the STDERR.


=cut
sub db_open
    {
      my ($self,%args) = @_;
      my ($dsn,$dbuser,$dbpass,$options,%rc,$dbh,$tmp,$name,$autocommit);
      my ($remaining,$raiseerror,@opts,%attr);

      printf STDERR "D[%s] db_open: args -> \'%s\'\n",$$,join(":",keys(%args)) if ($self->{debug});

      # quick error check
      foreach (qw(dsn dbuser dbpass))
        {
	 if (exists($args{$_}))
            {
	      $dsn	= $args{$_} if ($_ eq 'dsn');
	      $dbuser	= $args{$_} if ($_ eq 'dbuser');
	      $dbpass	= $args{$_} if ($_ eq 'dbpass');
	      delete $args{$_};
	    }
	   else
	    {
	      %rc= ( 'failed' => {'error' => "no $_ specified" } );
	      return \%rc;
	    }
	}
      foreach (keys %args)
       {
        $attr{$_}=$args{$_} if (
				($_ ne "dsn") &&
				($_ ne "dbuser") &&
				($_ ne "dbpass")
			       ) ;
       }
      # construct remaining arg string
      $remaining	= "";
      $attr{'AutoCommit'} = 1 if (!defined($attr{AutoCommit}));
      $attr{'RaiseError'} = 0 if (!defined($attr{RaiseError}));
      map { push @opts,(sprintf "%s => %s",$_,$attr{$_}) } (keys %attr) ;

      $remaining = join(", ",@opts);
      printf STDERR "D[%s] db_open: open optional args -> \'%s\'\n",$$,$remaining if ($self->{debug});

      # connect to DB
      $self->{_dbh}	= false;
      #$self->{_sth} 	= false;

      $self->{_dbh}= DBI->connect(
	    			  $dsn,
				  $dbuser,
				  $dbpass,
				  \%attr
				 );

      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});

      printf STDERR "D[%s]: DBIx::SimplePerl database connection succeeded\n",$$ if ($self->{debug});
      %rc= ( 'success' => true );
      printf STDERR "D[%s]: DBIx::SimplePerl database connection dump = %s\n",$$,Dumper($self) if ($self->{debug});
      # handle field quoting
      if (!defined($self->{quote}))
         {
          if ($dsn =~ /dbi:Pg/i)
	     { # postgresql
	       $self->{quote}->{table}='"';
	       $self->{quote}->{field}='"';
	       $self->{quote}->{value}="\'";
	     }
	  elsif ($dsn =~ /dbi:SQLite/i)
	     { # sqlite
	       $self->{quote}->{table}='"';
	       $self->{quote}->{field}="";
	       $self->{quote}->{value}='"';
	     }
	  elsif ($dsn =~ /DBI:mysql/i)
	     { # mysql
	       $self->{quote}->{table}="";
	       $self->{quote}->{field}="";
	       $self->{quote}->{value}='"';
	     }
	  else
	     { # default
	       $self->{quote}->{table}='"';
	       $self->{quote}->{field}="\'";
	       $self->{quote}->{value}='"';
	     }
         }
      return \%rc;
    }


sub db_add
    {
      my ($self,%args)=@_;
      my ($table,$q_table,$columns,$prep,%rc,@fields,@q_fields,@values);

      # quick error check
      foreach (qw(table columns))
        {
	 if (exists($args{$_}))
            {
	      $table	= $self->_quote_table($args{$_}) if ($_ eq 'table');
	      $columns	= $args{$_} if ($_ eq 'columns');
	    }
	   else
	    {
	      %rc= ( 'failed' => {'error' => "no $_ specified" } );
	      return \%rc;
	    }
	}

      if ( !defined( $self->{_dbh} ) )
         {
	   %rc= ( 'failed' => { 'error' => "Database handle does not exist" } );
	   return \%rc;
	 }

      # extract fields and values from the columns
      @fields=(keys %{$columns});
      map { push @values,$self->_quote_value($columns->{$_}) } @fields;
      map { push @q_fields,$self->_quote_field($_) } @fields;

      # create the SQL for the insert
      $prep  = sprintf 'INSERT INTO %s (',$table;
      $prep .= join(",",@q_fields). ') VALUES (';
      foreach (0 .. $#values)
        {
	  $prep .= sprintf "%s",$values[$_];
	  $prep .= "," if ($_ < $#values);
	}
      $prep .= ')';

      printf STDERR "D[%s] db_add: prepare = \'%s\' \n",
	   $$,$prep  if ($self->{debug});
      # compile it
      $self->{_sth} = $self->{_dbh}->prepare($prep) ;
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});

      printf STDERR "D[%s] db_add: prepare succeeded\n",$$ if ($self->{debug});

      # execute it ...
      $self->{_sth}->execute();
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});

      printf STDERR "D[%s] db_add: execute succeeded\n",$$ if ($self->{debug});
      %rc= ( 'success' => true );
      return \%rc;
    }

sub db_search
    {
      my ($self,%args)=@_;
      my ($table,$search,$prep,%rc,@fields,@values,@q_fields,$order);
      my ($count, $max, $min, $boolean, $in_variant,$v_values,$cols);
      my ($complex_cols,$specials,$distinct,$operator);

      $cols     = "*";
      $operator = "AND";

     # quick error check

      foreach (qw(table search order count max min boolean columns distinct search_operator))
        {
	 if (exists($args{$_}))
            {
	      $table	= $self->_quote_table($args{$_}) if ($_ eq 'table');
	      $search	= $args{$_} if ($_ eq 'search');
	      $order	= $args{$_} if ($_ eq 'order');
	      $cols	= $args{$_} if ($_ eq 'columns');
	      $distinct	= $args{$_} if ($_ eq 'distinct');
	      $operator	= $args{$_} if ($_ eq 'search_operator');
	      $count	= $args{$_} if ($_ eq 'count');
	      $max	= $args{$_} if ($_ eq 'max');
	      $min	= $args{$_} if ($_ eq 'min');
	    }
	}
      if (!defined($table))
	    {
	      %rc= ( 'failed' => {'error' => "no table specified" } );
	      return \%rc;
	    }

      if ( !defined( $self->{_dbh} ) )
         {
	   %rc= ( 'failed' => { 'error' => "Database handle does not exist" });
	   return \%rc;
	 }

      # only one of max, min, count.
      $specials=0;
      $specials++ if (defined($count));
      $specials++ if (defined($min));
      $specials++ if (defined($max));
      if ( $specials > 1 )
         {
	   %rc= ( 'failed' => { 'error' => "only one of MAX, MIN, COUNT can be used at a time in a query" } );
	   return \%rc;
	 }
      # if search is not defined, then use simpler form of
      # search (e.g. select * from table; )
      if (!defined($search))
         {
	  if ( (!defined($count)) && (!defined($min)) && (!defined($max)) && (!defined($distinct)) )
	   {
	    $prep  = sprintf 'SELECT %s FROM %s',$cols,$table;
	   }
	  elsif (defined($count))
	   {
	     $prep  = sprintf 'SELECT count(%s) FROM %s',$count,$table;
	   }
	  elsif (defined($max))
	   {
	     $prep  = sprintf 'SELECT max(%s) FROM %s',$max,$table;
	   }
	  elsif (defined($min))
	   {
	     $prep  = sprintf 'SELECT min(%s) FROM %s',$min,$table;
	   }
          elsif (defined($distinct))
           {
             $prep .= sprintf 'SELECT DISTINCT %s FROM %s',$distinct,$table;
           }
	 }
	elsif (
	      (defined($search)) &&
	      (
	       (!defined($count)) &&
	       (!defined($min)) &&
	       (!defined($max))
	      )
	     )
	   {
	  $prep  = sprintf 'SELECT %s FROM %s WHERE ',$cols,$table;
	  # extract fields and values from the columns
	  @fields=(keys %{$search});
          map { push @q_fields,$self->_quote_field($_) } @fields;
	  $in_variant	=  (1==0);	#force it to false

	  # see if we are dealing with a field => [array of values]
	  # if this is the case, the we need to construct the search
	  # using the where field in ('value1', 'value2', ... , 'valueN')
	  map {
	        $in_variant = (1==1) if (ref($search->{$_}) eq "ARRAY");
	      } @fields;

	  if (!$in_variant)
	   {
	    # normal method, using simple scalar values for fields
            map { push @values,$self->_quote_value($search->{$_}) } @fields;

	    # create the SQL for the insert
	    foreach (0 .. $#q_fields)
              {
	       $prep .= (defined($self->{search_condition}) ? $self->{search_condition} : " AND ") if ($_ > 0);
	       $prep .= sprintf "%s=%s",$q_fields[$_],$values[$_];
	      }
	   }
	   else
	   {
	    # more complex method.  First scan through the non-array bits
	    # and add them.  Then

	    my $_count=1;
	    foreach (@fields)
	     {
	      $prep .= " AND " if ($_count > 1);
	      if (ref($search->{$_}) ne "ARRAY")
	       {
	        $prep .= sprintf "%s=%s",$self->_quote_field($_),
		$self->_quote_value($search->{$_});
	       }
	       else
	       {
	        my $_in_="(";
		my $_field_=$_;
		foreach (@{$search->{$_}})
		 {
		  $_in_ .= (sprintf "%s, ",$self->_quote_value($_));
		 }
		$_in_ .= ")";
		$_in_ =~ s/\,\s+\)$/\)/; # clean up the last comma
		$prep .= sprintf "%s in %s",$self->_quote_field($_field_),$_in_;
	       }
	      $_count++;
	     }
	   }
	  }
	 elsif (
		(defined($search)) &&
		(
		 (defined($count)) ||
		 (defined($min)) ||
		 (defined($max))
		)
	       )
	   {
	  $complex_cols	= sprintf "MAX(%s)",$max if (defined($max));
	  $complex_cols	= sprintf "MIN(%s)",$min if (defined($min));
	  $complex_cols	= sprintf "COUNT(%s)",$count if (defined($count));

	  $prep  = sprintf 'SELECT %s FROM %s WHERE ',$complex_cols,$table;
	  # extract fields and values from the columns
	  @fields=(keys %{$search});
          map { push @q_fields,$self->_quote_field($_) } @fields;
	  $in_variant	=  (1==0);	#force it to false

	  # see if we are dealing with a field => [array of values]
	  # if this is the case, the we need to construct the search
	  # using the where field in ('value1', 'value2', ... , 'valueN')
	  map {
	        $in_variant = (1==1) if (ref($search->{$_}) eq "ARRAY");
	      } @fields;

	  if (!$in_variant)
	   {
	    # normal method, using simple scalar values for fields
            map { push @values,$self->_quote_value($search->{$_}) } @fields;

	    # create the SQL for the insert
	    foreach (0 .. $#q_fields)
              {
	       $prep .= (sprintf " %s ",$operator) if ($_ > 0);
	       $prep .= sprintf "%s=%s",$q_fields[$_],$values[$_];
	      }
	   }
	   else
	   {
	    # more complex method.  First scan through the non-array bits
	    # and add them.  Then

	    my $_count=1;
	    foreach (@fields)
	     {
	      $prep .= (sprintf " %s ",$operator) if ($_count > 1);
	      if (ref($search->{$_}) ne "ARRAY")
	       {
	        $prep .= sprintf "%s=%s",$self->_quote_field($_),
		$self->_quote_value($search->{$_});
	       }
	       else
	       {
	        my $_in_="(";
		my $_field_=$_;
		foreach (@{$search->{$_}})
		 {
		  $_in_ .= (sprintf "%s, ",$self->_quote_value($_));
		 }
		$_in_ .= ")";
		$_in_ =~ s/\,\s+\)$/\)/; # clean up the last comma
		$prep .= sprintf "%s in %s",$self->_quote_field($_field_),$_in_;
	       }
	      $_count++;
	     }
	   }
#############
         }
      if (defined($order))      { $prep .= (sprintf " ORDER BY %s ",$order)}
      printf STDERR "D[%s] db_search: prepare = \'%s\' \n",
	   $$,$prep  if ($self->{debug});

      # compile it
      $self->{_sth} = $self->{_dbh}->prepare($prep);
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});

      printf STDERR "D[%s] db_search: prepare succeeded\nprepare: %s\n",$$,$prep if ($self->{debug});


      # execute it ...
      printf STDERR "D[%s] db_search: executing search\n",$$ if ($self->{debug});
      $self->{_sth}->execute();
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_search: execute succeeded\n",$$ if ($self->{debug});

      %rc= ( 'success' => true );
      return \%rc;
    }

sub db_update
    {
      my ($self,%args)=@_;
      my ($table,$search,$columns,$prep,%rc,@sfields,@svalues,@cfields,@cvalues);
      my (@q_sfields,@q_cfields);

      # quick error check
      foreach (qw(table search columns))
        {
	 if (exists($args{$_}))
            {
	      $table	= $self->_quote_table($args{$_}) if ($_ eq 'table');
	      $search	= $args{$_} if ($_ eq 'search');
	      $columns	= $args{$_} if ($_ eq 'columns');
	    }
	   else
	    {
	      %rc= ( 'failed' => {'error' => "no $_ specified" } );
	      return \%rc;
	    }
	}

      if ( !defined( $self->{_dbh} ) )
         {
	   %rc= ( 'failed' => { 'error' => "Database handle does not exist" } );
	   return \%rc;
	 }

      # extract fields and values from the columns
      @sfields=(keys %{$search});
      map { push @svalues,$self->_quote_value($search->{$_}) } @sfields;
      map { push @q_sfields,$self->_quote_field($_) } @sfields;
      @cfields=(keys %{$columns});
      map { push @cvalues,$self->_quote_value($columns->{$_}) } @cfields;
      map { push @q_cfields,$self->_quote_field($_) } @cfields;

      # create the SQL for the insert
      $prep  = sprintf 'UPDATE %s  SET ',$table;
      foreach (0 .. $#cfields)
        {
	 $prep .= "," if ($_ > 0);
	 $prep .= sprintf "%s=%s",$q_cfields[$_],$cvalues[$_];
	}
      $prep .= ' WHERE ';
      foreach (0 .. $#sfields)
        {
	 $prep .= "," if ($_ > 0);
	 $prep .= sprintf "%s=%s",$q_sfields[$_],$svalues[$_];
	}
      printf STDERR "D[%s] db_update: prepare = \'%s\' \n",
	   $$,$prep  if ($self->{debug});


      # compile it
      $self->{_sth} = $self->{_dbh}->prepare($prep) ;
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_update: prepare succeeded\n",$$ if ($self->{debug});


      # execute it ...
      $self->{_sth}->execute();
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_update: execute succeeded\n",$$ if ($self->{debug});

      %rc= ( 'success' => true );
      return \%rc;
    }

sub db_delete
    {
      my ($self,%args)=@_;
      my ($table,$search,$prep,%rc,@fields,@values,@q_fields);

      # quick error check
      foreach (qw(table search))
        {
	 if (exists($args{$_}))
            {
	      $table	= $self->_quote_table($args{$_}) if ($_ eq 'table');
	      $search	= $args{$_} if ($_ eq 'search');
	    }
	   else
	    {
	      %rc= ( 'failed' => {'error' => "no $_ specified" } );
	      return \%rc;
	    }
	}

      if ( !defined( $self->{_dbh} ) )
         {
	   %rc= ( 'failed' => { 'error' => "Database handle does not exist" } );
	   return \%rc;
	 }

      # extract fields and values from the columns
      @fields=(keys %{$search});
      map { push @values,$self->_quote_value($search->{$_}) } @fields;
      map { push @q_fields,$self->_quote_field($_) } @fields;


      # create the SQL for the delete
      $prep  = sprintf 'DELETE FROM %s WHERE ',$table;
      foreach (0 .. $#fields)
        {
	 $prep .= " AND " if ($_ > 0);
	 $prep .= sprintf "%s=%s",$q_fields[$_],$values[$_];
	}
      printf STDERR "D[%s] db_delete: SQL=\'%s\'\n",$$,$prep  if ($self->{debug});


      # compile it
      $self->{_sth} = $self->{_dbh}->prepare($prep);
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_delete: prepare succeeded\n",$$ if ($self->{debug});

      # execute it ...
      $self->{_sth}->execute();
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_delete: execute succeeded\n",$$ if ($self->{debug});

      %rc= ( 'success' => true );
      return \%rc;
    }

sub db_next
    {
      my ($self,%args)=@_;
      my $rc;
      # quick sanity check: return undef if no session handle to query from
      return undef if (!($self->{_sth}));
      printf STDERR "D[%s] db_next: returning hashref\n",$$ if ($self->{debug});
      $rc= $self->{_sth}->fetchrow_hashref;
      return $rc;
    }

sub db_array
    {
      my ($self,%args)=@_;
      my $rc;
      # quick sanity check: return undef if no session handle to query from
      return undef if (!($self->{_sth}));
      printf STDERR "D[%s] db_array: returning array of hashes\n",$$ if ($self->{debug});
      $rc= $self->{_sth}->fetchall_arrayref({});
      return $rc;
    }

sub db_rows
    {
      my ($self,%args)=@_;
      my $rc;
      # quick sanity check: return undef if no session handle to query from
      return undef if (!($self->{_sth}));
      $rc=$self->{_sth}->rows;
      printf STDERR "D[%s] db_rows: returning %s\n",$$,$rc if ($self->{debug});
      return $rc;
    }

sub db_ping
    {
      my ($self,%args)=@_;
      # quick sanity check: return undef if no db handle set up
      return undef if (!($self->{_dbh}));
      return $self->{_dbh}->ping;
    }

sub db_rollback
    {
      my ($self,%args)=@_;
      # quick sanity check: return undef if no db handle set up
      return undef if (!($self->{_dbh}));
      eval { $self->{_dbh}->rollback; };
      return $@;
    }

sub db_trace
    {
      my ($self,%args)=@_;
      my ($level,$file);
      if (!($self->{_dbh}))
       {
        my %rc= ( 'failed' => {'error' => "no database connection to trace" } );
	return \%rc;
       }
      foreach (qw(level file))
        {
	 if (exists($args{$_}))
            {
	     $level	= $args{$_} if ($_ eq 'level');
	     $file	= $args{$_} if ($_ eq 'file');
	    }
	   else
	    {
	     my %rc= ( 'failed' => {'error' => "no $_ specified" } );
	     return \%rc;
	    }
	}
      if (!$file)
       {
        $self->{_dbh}->trace($level);
       }
       else
       {
        $self->{_dbh}->trace($level,$file);

       }
      # quick sanity check: return undef if no session handle to query from
      return $self->{_sth}->fetchrow_hashref;
    }
sub db_close
    {
      my ($self )=shift;
      my %rc;
      if (defined($self->{_sth})) { undef $self->{_sth} ; }
      $self->{_dbh}->disconnect();
      printf STDERR "D[%s] db_close\n",$$ if ($self->{debug});
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});

      %rc= (  'success' => true );
      return \%rc;
    }

sub db_commit
    {
      my ($self )=shift;
      my %rc;
      $self->{_dbh}->commit() if (defined($self->{_dbh}));
      printf STDERR "D[%s] db_commit\n",$$ if ($self->{debug});
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});

      %rc= (  'success' => true );
      return \%rc;
    }

sub db_create_table
    {
      my ($self,%args)=@_;
      my ($table,$columns,$prep,%rc,@fields,%types,@q_fields);

      # quick error check
      foreach (qw(table columns))
        {
	 if (exists($args{$_}))
            {
	      $table	= $self->_quote_table($args{$_}) if ($_ eq 'table');
	      $columns	= $args{$_} if ($_ eq 'columns');
	    }
	   else
	    {
	      %rc= ( 'failed' => {'error' => "no $_ specified" } );
	      return \%rc;
	    }
	}

      if ( !defined( $self->{_dbh} ) )
         {
	   %rc= ( 'failed' => { 'error' => "Database handle does not exist" } );
	   return \%rc;
	 }

      # extract fields and values from the columns
      @fields=(keys %{$columns});
      map { $types{$_}=$columns->{$_} } @fields;
      map { push @q_fields,$self->_quote_field($_) } @fields;

      # create the SQL for the insert
      $prep  = sprintf 'CREATE TABLE %s (',$table;
      $prep .= "\n";

      foreach (0 .. $#fields)
        {
	  $prep .= sprintf "\t%s   %s",$q_fields[$_],$types{$fields[$_]};
	  $prep .= ",\n" if ($_ < $#fields);
	}
      $prep .= ')';
      printf STDERR "D[%s] db_create_table: SQL=\'%s\'\n",$$,$prep  if ($self->{debug});

      # compile it
      $self->{_sth} = $self->{_dbh}->prepare($prep);
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_create_table: prepare succeeded\n",$$ if ($self->{debug});

      # execute it ...
      $self->{_sth}->execute();
      %rc=%{$self->_check_and_return_if_error};
      return \%rc if ($rc{failed});
      printf STDERR "D[%s] db_create_table: execute succeeded\n",$$ if ($self->{debug});

      %rc= ( 'success' => true );
      return \%rc;
    }

sub _quote_table
    {
      my ($self,$value) = @_;
      my $_x = sprintf "%s%s%s",
      			$self->{quote}->{table},
			$value,
			$self->{quote}->{table};
      return $_x;
    }
sub _quote_field
    {
      my ($self,$value) = @_;
      my $_x = sprintf "%s%s%s",
      			$self->{quote}->{field},
			$value,
			$self->{quote}->{field};
      return $_x;
    }
sub _quote_value
    {
      my ($self,$value) = @_;
      my $_x = sprintf "%s%s%s",
      			$self->{quote}->{value},
			$value,
			$self->{quote}->{value};
      return $_x;
    }

sub _check_and_return_if_error
    {
      my ($self) = @_;
      my %rc;
      if (
	  (defined($self->{_dbh}->err))	&&
	  ($self->{_dbh}->err)
	 )
	 {
	   printf STDERR "D[%s]: DBIx::SimplePerl database error \'%s\'\n",$$,$self->{_dbh}->err  if ($self->{debug});
	   %rc= (
	   	 'failed' => {
		 	      'error'	=> $self->{_dbh}->errstr ,
			      'code'	=> $self->{_dbh}->err
			     }
		);
           return \%rc;
	 }

      if (
          (defined($self->{_sth} )) 	&&
	  (defined($self->{_sth}->err))	&&
	  ($self->{_sth}->err)
	 )
	 {
	   printf STDERR "D[%s]: DBIx::SimplePerl session handle error \'%s\'\n",$$,$self->{_sth}->err  if ($self->{debug});
	   %rc= (
	   	 'failed' => {
		 	      'error'	=> $self->{_sth}->errstr ,
			      'code'	=> $self->{_sth}->err
			     }
		);
           return \%rc;
	 }
    }
=cut
=pod
=back

=head1 EXAMPLE

Suppose you have a nice database, a SQLite in this case, though it
will work perfectly well with Mysql, Postgres, and anything else
DBI supports.  This database has a list of host names and MAC
addresses, and you want to list them from the database.

The table has been created using:


 CREATE TABLE hosts (
        mac_address      text,
        ip_address       text,
        dhcp_ipaddress   text,
        host_name        text,
        host_domain      text,
        net_device       text,
        gateway          text,
        netmask          text,
        mtu              text,
        options          text
        );


and the script looks like this


 #!/usr/bin/perl

 use strict;
 use DBIx::SimplePerl;
 my ($dbh,$err,$sice);
 my ($rc,$debug,$q);

 $debug	= 1;
 $sice   = SICE->new( { debug=>$debug } );
 $sice->db_open(
                 'dsn'           => "dbi:SQLite:dbname=/etc/cluster/cluster.db",
                 'dbuser'        => "",
                 'dbpass'        => ""
               );

 printf "Machines in cluster.db\n" ;
 $rc     = $sice->db_search('table' => 'hosts');
 if (defined($rc->{success}))
    {
       printf "mac\t\t\tip\t\thostname\n" ;
       $q=($sice->{_sth}->fetchall_hashref('mac_address'));
       foreach (sort keys %{$q})
	{
         printf "%s\t%s\t%s\n", $_,
	 			$q->{$_}->{ip_address},
				$q->{$_}->{host_name} ;
	}
    }
   else
    {
       printf "WARNING: the search did not succeed.\n
       	       DB returned the following error:\n\n%s\n\n",
	       $rc->{failed};
    }
 $sice->db_close;

The db_search does the query, and stores the result in a session
handle stored  as $object_name->{_sth}.  You can then use your
favorite DBI method to pull  out the records.  What DBI Simple
saves you is writing SQL.  It will do that portion for you.  If you
turn debugging by creating the object with  debug=>1, then you can
watch the SQL that is generated.

=head1 WHY

Why hide SQL?  That question should answer itself, especially in
programs not requiring the full firepower of a Class::DBI,
DBIx::Class or most of the DBI methods.   It is fairly easy to
make a mistake in the SQL you generate, and debugging  it can be
annoying.  This was the driving force behind this particular
module.  The SQL that is generated is fairly simple minded.  It
is executed,  and results returned.  If it fails, this is also
caught and what DBI thinks is the reason it failed is returned as
the $object->{failed} message.

This module is not for the folks who need the full firepower of
most of the rest of DBI.  This module is for simple programs.  If
you exceed the  capabilities of this module, then please look to
one of the other modules that do DBs.

The approach to this module is simplicity.  It is intended to be
robust  for basic applications, and it is used in a few commercial
products.

=head1 AUTHOR

Joe Landman ([e-mail])


=head1 COPYRIGHT

Copyright (c) 2003-2007 Scalable Informatics LLC.  All rights
reserved.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself, either Perl version
5.8.6 or, at your option, any later version of Perl 5 you may have
available.

=head1 SEE ALSO

perl(1), DBI, Class::Accessor

=head1 BUGS

Well, quite likely.  SQL is a standard, and standards are open to
interpretation.  This means that some things may not work as
expected. We have run into issues in quoting fields and values,
where DBD::Mysql happily accepted input that DBD::Pg croaked on.
This module is known to work without noticable issues on DBD::SQLite,
DBD::Mysql, DBD::Pg.  Others may or may not work, depending upon
how compatible they are with the specs in DBI for DBD module writers.

Note: as of 1.50, RaiseError is set to 0.  If you want the code to
throw a signal upon an error, set this to 1 when you create the object.
Also, the handles now are all outside of evals.  This is to make error
handling saner.
=cut

1;
__END__