#!/usr/bin/perl -w

package DBIx::Pretty;


#=============================================================================
#
# $Id: Pretty.pm,v 0.1 2001/07/01 01:57:49 mneylon Exp $
# $Revision: 0.1 $
# $Author: mneylon $
# $Date: 2001/07/01 01:57:49 $
# $Log: Pretty.pm,v $
# Revision 0.1  2001/07/01 01:57:49  mneylon
#
# Initial revision
#
#
#=============================================================================

use strict;
use DBI;
use Carp;

use vars qw( $AUTOLOAD ) ;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
    $VERSION     = sprintf( "%d.%02d", '$Revision: 0.1 $' =~ /\s(\d+)\.(\d+)/ );
    @ISA         = qw( Exporter );
    @EXPORT      = qw( add_sql );
    %EXPORT_TAGS = ( );
}

sub new {
    my $class = shift;
    my $dbi = shift;
    croak "DBI::Pretty requires a valid DBI object"
      unless $dbi;
    my $hash = shift || {};

    my $self = { dbi => $dbi,
		 calls => {} };
    bless $self, $class;
    
    add_sql( $self, $hash );
    
    return $self;
}

sub DESTROY {
    # Nothing to do!
}

sub add_sql
{
    my $self = shift;
    croak "First argument must be a DBI::Pretty object" 
      unless $self->isa( "DBI::Pretty" );
    my $hash = shift || {};
    foreach my $key ( keys %$hash ) {
	next if $key eq "DESTROY";        # Safety purposes
	next if $key !~ /\w+/;            # Let's not screw up perl
	my %sqlhash = _process_sql_statement( $hash->{ $key } );
	$self->{ calls }->{ $key } = \%sqlhash;
    }
}


sub _process_sql_statement
{
    my $sql = shift || "";
    
    my %nq_hash;
    my %q_hash;
    
    # For non-quoted placeholders, we simply need to identify them
    
    foreach ( $sql =~ /\$(\w+)/g ) {
	$nq_hash{ "\$$_" } = $_;
    }
    
    # For the quoted characters, we want to strip that from the 
    # sql statement, and note the order that it was in.  Since
    # the same keyword may be used multiple times, we use a 
    # array here to store positions.
    
    my $order = 0;
    while ( $sql =~ s/\?(\w+)/\?/ ) {
	$q_hash{ $1 } ||= [];
	push @{$q_hash{ $1 }}, $order++;
    }
    
    my %fhash = ( sql        => $sql,
		  non_quoted => \%nq_hash,
		  quoted     => \%q_hash
		);
    return %fhash;
}

# it's magic time!

sub AUTOLOAD {
    my $self = shift;
    my $type = ref( $self )
      or croak "$self is not an object!";
    
    return if $AUTOLOAD eq 'DESTROY';
    
    my $name = $AUTOLOAD;
    $name =~ s/.*://;     # Strip all but necessary
    
    croak "No method $name defined yet in $type"
      unless ( exists $self->{ calls }->{ $name } );
    
    my $arghash = shift || {};
    
    # Now, we prepare the call to DBI's functions:

    my $statement = $self->{ calls }->{ $name }->{ sql };

    
    # So that "$tex" doesn't subsitute for "$text", sort from 
    # longest to shorted variable name and process in that order
    my @sorted_by_length_keys = 
      sort { length $b <=> length $a } 
      keys %{ $self->{ calls }->{ $name }->{ non_quoted } };
    
    foreach my $nq ( @sorted_by_length_keys ) {
	my $replace = $arghash->{ 
	    $self->{ calls }->{ $name }->{ non_quoted }->{ $nq } };
	$statement =~ s/\Q$nq\E/$replace/eg;   # in case we duplicate
    }

    # The statement should now be clear of anything beyond placeholders,
    # so now we just need to arrange the objects passed in order
    
    my @args;
    foreach my $q ( keys %{ $self->{ calls }->{ $name }->{ quoted } } ) {
	foreach my $pos 
	  ( @{ $self->{ calls }->{ $name }->{ quoted }->{ $q } } ) {
	      $args[ $pos ] = $arghash->{ $q };
	  }
    }
    
    # Finally, we have the statement and arguments ready! Call the DBI
    # stuff!
    my $sth = $self->{ dbi }->prepare( $statement );
    return if DBI::errstr;
    $sth->execute( @args ) or die DBI::errstr;
    return if DBI::errstr;
    return $sth;
}

42;

__END__

=pod

=head1 NAME

DBIx::Pretty - 'Cleans up' calls to DBI functions
  
=head1 SYNOPSIS

    use DBI;
    use DBIx::Pretty;

    my $dbi->connect($method, $user, $pass );

    my $dbp = DBI::Pretty->new( $dbi ,
        { CUSTOMER_SELECT=>
             'SELECT $fields FROM customers WHERE $field LIKE ?value',
          CUSTOMER_UPDATE=>
             'UPDATE customers SET balance=?new_balance WHERE custID = ?id' }
      );

    my $sth = $dbp->CUSTOMER_SELECT(
        { fields => 'custID, name',
          field  => 'name',
          value  => '?Wall' } ) or die DBI::errstr;

    my $sth2 = $dbp->CUSTOMER_UPDATE( 
        { new_balance => 10000,
          custID      => 101 } ) or die DBI::errstr;

=head1 DESCRIPTION

While the DBI modules is nearly a requirement in any modern perl programmer's 
toolbox, the code that is generated when using DBI can become message and
hard to follow.  For example, a typical DBI call may be something like:

    my $sth = $dbi->prepare(
        "SELECT custID, name, balance FROM customers WHERE balance > ?" )
        or die DBI::errstr;
    $sth->execute( $balance_min ) or die DBI::errstr;

While this is direct, it is rather looming on the code itself, and with
the addition of placeholders, it may be confusing for future maintainers
of code.  In addition, sometimes many SQL statements will be used in the
code that only vary slightly, such as changing which fields to return
or the order to return them in.

C<DBIx::Pretty> attempts to overcome this with two steps: first, all SQL calls
are defined at one point in one class object, such that the SQL don't 
clutter the code.  Secondly, the SQL statements are allowed to define 
'meta-variables', which can be replaced just prior to the execute() call;
these not only can be placeholder variables, but can also be parts of 
SQL code that may change depending on the part of the code that you are in.
For example, a meta-SQL statement that can be used is as follows.

    'SELECT $fields FROM $table WHERE $column=?value'

Note that there are two types of meta-variables.  Variables that are preceeded
with a '?' (or in RE terms: /\?\w+/) are considered as placeholders, and the
standard method of using DBI to quote the data that goes into these will be
used.  Variables that are preceeded by a '$' are considered as non-quoted
variables; the values will be substituted before the call to prepare() 
is used.  B<Consider yourself warned!> : Because these values are not
quoted, you should absolutely make sure that the values that you pass
into these non-quoted variables are untainted.  B<Any problems you incure
for ignoring this advice are your own fault!>  These non-quoted variables 
are ideal for passing in field lists, column names, or other more specific
SQL portions of the code, as opposed to values that are in WHERE or SET 
clauses.  Note that because the non-quoted variables start with '$', you
B<must> define these meta-SQL statements either with single quotes (or q()),
or with double quotes and escaping the '$' characters (or qq()) (unless, 
of course, you DO want to have interpolation taking place before the SQL 
strings are passed to DBI::Pretty's internals!)

The use of C<DBIx::Pretty> is straightforward.  The constructor of the class
requires an existing database connection ($dbi), and an optional hashref.  
Each hash element consists of an identifier (which must be /\w+/) as the key
and the meta-SQL statement as the identifier.  Once the class object is
created, you can then call the entire DBI process/execute sequence for
a given SQL statement by $dbp->IDENTIFIER, where IDENTIFIER is the 
identifier previous given in the hash above.  The argument to this 
dynamic function, if needed, is a hashref; the keys of the hash are 
the meta-variable names (sans '?' or '$') from above, and the values
are what are to be used in the SQL statement.  This dynamic function
will either return an STH object, ready for use via fetchrow() for example,
or will return undef; any errors from the DBI calls will be in their
usual place in the DBI classes (read: DBI::errstr).

C<add_sql> can be used to add new SQL statements to the DBIx::Pretty object
after it has been created; the argument here should also be a hashref 
created in the same fashion as above.

=head1 HISTORY

    $Date: 2001/07/01 01:57:49 $

    $Log: Pretty.pm,v $
    Revision 0.1  2001/07/01 01:57:49  mneylon

    Initial revision


=head1 AUTHOR

This package was written by Michael K. Neylon

=head1 COPYRIGHT

Copyright 2001 by Michael K. Neylon

=head1 LICENSE

This program is Copyright 2001 by Michael K. Neylon.

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT
OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.


=cut