—package
Tao::DBI::st;
use
5.006;
use
strict;
use
warnings;
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*
# 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