package Tao::DBI::st;
use 5.006;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw();
our $VERSION = '0.012';
use Carp;
# the instance variables:
# DBH
# SQL
# PLACES, (the mapping between anonymous placholders and named placeholders)
# ARGNS (the current argument names)
# STMT
#
# NAME
# creates a Tao::DBI::st object (the statement is
# prepared during initialization).
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $obj = bless {}, $class;
return $obj->initialize(@_);
}
# { dbh => , sql => }
sub initialize {
my ( $self, $args ) = @_;
croak "argument 'sql' undefined" unless defined $args->{sql};
my $sql = $self->{SQL} = $args->{sql};
croak "argument 'dbh' is required" unless $args->{dbh};
$self->{DBH} = $args->{dbh};
my ( $ssql, $places, $argns ) = strip($sql);
$self->{PLACES} = $places;
$self->{ARGNS} = $argns;
if ( $self->{DBH}->isa('Tao::DBI::db') ) {
$self->{STMT} = $self->{DBH}->{DBH}->prepare($ssql);
# FIXME: needs to support optional args
# FIXME: knows too much on Tao::DBI::db
}
else {
$self->{STMT} = $self->{DBH}->prepare($ssql);
}
unless ( $self->{STMT} ) {
%$self = ();
return undef;
}
return $self;
}
# ($ssql, $places, $argns) = strip($sql);
sub strip {
my $sql = shift;
my $ssql = '';
my @places = ();
my %args = ();
for ( $_ = $sql ; ; ) {
$ssql .= ':', next
if /\G::/gc;
$ssql .= "?", push( @places, $1 ), $args{$1} = 1, next
if /\G:(\w+)/gc;
$ssql .= $1, next
if /\G(:?[^:]*)/gc;
last;
}
# if not at the end of string, invalid use of :[^\w:] -> not yet implemented
my @argns = keys %args;
return ( $ssql, \@places, \@argns );
}
# $stmt->execute($hash_ref)
# $stmt->execute($scalar)
# $stmt->execute
sub execute {
my $self = shift;
my $args = shift;
if ( !$args ) {
if ( @{ $self->{ARGNS} } ) {
croak "execute on SQL::Statement missing arguments";
}
return $self->{STMT}->execute;
}
elsif ( ref $args ) {
return $self->{STMT}->execute( @{$args}{ @{ $self->{PLACES} } }, @_ );
}
else {
if ( @{ $self->{ARGNS} } != 1 ) {
croak
"execute on SQL::Statement with a single non-ref argument only for one-parameter statements";
}
return $self->{STMT}->execute( ($args) x @{ $self->{PLACES} }, @_ );
}
}
# fetch*
use vars qw($AUTOLOAD);
# If method wasn't found, delegates to STMT instance variable.
# This way, instances of this class behaves like DBI statements.
sub AUTOLOAD {
my $self = shift;
my $meth = $AUTOLOAD;
$meth =~ s/.*:://;
return $self->{STMT}->$meth(@_);
}
sub DESTROY { }
1;
# NOTE.
# In SQL statements, ':' has a special meaning as the prefix of a placeholder.
# If you need to include ':' within a statement to be literally interpreted,
# double it: '::'.
__END__
=head1 NAME
Tao::DBI::st - DBI statements with portable support for named placeholders
=head1 SYNOPSIS
use Tao::DBI qw(dbi_connect dbi_prepare);
$dbh = dbi_connect($args);
$sql = q{UPDATE T set a = :a, b = :b where k = :k};
$stmt = $dbh->prepare($sql);
$rc = $stmt->execute({ k => $k, a => $a, b => $b });
# dbi_prepare() can also be used to create Tao::DBI::st
$stmt = dbi_prepare($sql, { dbh => $dbh });
=head1 DESCRIPTION
=over 4
=item B<execute>
$sth->execute($hash);
$sth->execute($param);
$sth->execute;
Returns
=back
=head2 EXPORT
Nothing to be exported. Every method is available as a method.
=begin comment
=head1 SEE ALSO
=end comment
=head1 BUGS
Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tao-DBI>.
=head1 AUTHOR
Adriano R. Ferreira, E<lt>ferreira@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005, 2006 by Adriano R. Ferreira
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut