File Coverage

blib/lib/DBIx/bind_param_inline.pm

Criterion	Covered	Total	%
statement	11	45	24.4
branch	0	6	0.0
condition	0	2	0.0
subroutine	4	8	50.0
pod	0	2	0.0
total	15	63	23.8

package DBIx::bind_param_inline;

use 5.008008;
use warnings;

our $VERSION = '0.03';

use Carp;


sub prepare_inline($$;$){
    my $dbh = shift;
    my $SQL = shift;
    my @EPs;
    my $attrs = shift || {};
    while($SQL =~ /[?]/){
        my $explicit_placeholder;
        push @EPs, \$explicit_placeholder;
        $SQL =~ s/[?]/\$___explicit__wedfgh__placeholder___/;
    };
    my $pkg = caller();
    my $EPindex = 0;
    my @placeholder_refs = map {
        $_ eq '___explicit__wedfgh__placeholder___'
        ?
        $EPs[$EPindex++]
        :
        \${"$pkg\::$_"}
    } ($SQL =~ /\$(\w+)/g) ;
    $SQL =~ s/\$(\w+)/ ? /g ;
    my $sth = (
                             defined($attrs)
                                     ?
        $dbh->prepare($SQL,$attrs)   :   $dbh->prepare($SQL)
    );

    bless [$sth, \@EPs, @placeholder_refs]
};

sub import{
    *{caller().'::prepare_inline'} = \&prepare_inline
};

sub execute{
    my $objref = shift;
    my @obj = @$objref; # a copy, so we can shift from it nondestructively
    my $sth = shift @obj;
    my $EPref = shift @obj;
    @$EPref == @_ or
     croak "Wrong number of explicit placeholders in execute of inline-bound statement handle: ".
        "need ".@$EPref." but got ".@_." parameters" ;
    for (@$EPref){
        $$_ = shift;  # load explicit placeholders
    };
    my $pnum = 1;
    while (@obj){
        $sth->bind_param($pnum++, ${shift @obj});
    };
    $sth->execute;

};

our $AUTOLOAD;

sub AUTOLOAD{
    my $name = $AUTOLOAD;
    # uncomment the next line to see memoized autoloading in action
    # warn "AUTOLOADING $name";
    $name =~ s/.*://;   # strip fully-qualified portion
    eval 'sub '.$name.'{
        my $objref = shift;
        my $sth = $objref->[0];
        $sth->'.$name.'(@_)
    }';

    goto &$name
}

sub DESTROY{
    # autoloading this is poor form, considering it
    # is conceivable that we might have other references to the $sth
    @{$_[0]} = ();
};

1;
__END__