Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

379 lines (320 sloc) 10.173 kB
package DBD::Mock::st;
use strict;
use warnings;
our $imp_data_size = 0;
sub bind_col {
my ( $sth, $param_num, $ref, $attr ) = @_;
my $tracker = $sth->FETCH('mock_my_history');
$tracker->bind_col( $param_num, $ref );
return 1;
}
sub bind_param {
my ( $sth, $param_num, $val, $attr ) = @_;
my $tracker = $sth->FETCH('mock_my_history');
$tracker->bound_param( $param_num, $val );
return 1;
}
sub bind_param_inout {
my ( $sth, $param_num, $val, $max_len ) = @_;
# check that $val is a scalar ref
( UNIVERSAL::isa( $val, 'SCALAR' ) )
|| $sth->{Database}
->set_err( 1, "need a scalar ref to bind_param_inout, not $val" );
# check for positive $max_len
( $max_len > 0 )
|| $sth->{Database}
->set_err( 1, "need to specify a maximum length to bind_param_inout" );
my $tracker = $sth->FETCH('mock_my_history');
$tracker->bound_param( $param_num, $val );
return 1;
}
sub execute {
my ( $sth, @params ) = @_;
my $dbh = $sth->{Database};
unless ( $dbh->{mock_can_connect} ) {
$dbh->set_err( 1, "No connection present" );
return 0;
}
unless ( $dbh->{mock_can_execute} ) {
$dbh->set_err( 1, "Cannot execute" );
return 0;
}
$dbh->{mock_can_execute}++ if $dbh->{mock_can_execute} < 0;
my $tracker = $sth->FETCH('mock_my_history');
if ( $tracker->has_failure() ) {
$dbh->set_err( $tracker->get_failure() );
return 0;
}
if (@params) {
$tracker->bind_params(@params);
}
if ( my $session = $dbh->{mock_session} ) {
eval {
my $state = $session->current_state;
$session->verify_statement( $sth->{Statement});
$session->verify_bound_params( $tracker->bound_params() );
# Load a copy of the results to return (minus the field
# names) into the tracker
my @results = @{ $state->{results} };
shift @results;
$tracker->{return_data} = \@results;
};
if ($@) {
my $session_error = $@;
chomp $session_error;
$sth->set_err( 1, "Session Error: ${session_error}" );
return;
}
}
$tracker->mark_executed;
my $fields = $tracker->fields;
$sth->STORE( NUM_OF_PARAMS => $tracker->num_params );
# handle INSERT statements and the mock_last_insert_ids
# We should only increment these things after the last successful INSERT.
# -RobK, 2007-10-12
#use Data::Dumper;warn Dumper $dbh->{mock_last_insert_ids};
if ( $dbh->{Statement} =~ /^\s*?insert\s+into\s+(\S+)/i ) {
if ( $dbh->{mock_last_insert_ids}
&& exists $dbh->{mock_last_insert_ids}{$1} )
{
$dbh->{mock_last_insert_id} = $dbh->{mock_last_insert_ids}{$1}++;
}
else {
$dbh->{mock_last_insert_id}++;
}
}
#warn "$dbh->{mock_last_insert_id}\n";
# always return 0E0 for Selects
if ( $dbh->{Statement} =~ /^\s*?select/i ) {
return '0E0';
}
return ( $sth->rows() || '0E0' );
}
sub fetch {
my ($sth) = @_;
my $dbh = $sth->{Database};
unless ( $dbh->{mock_can_connect} ) {
$dbh->set_err( 1, "No connection present" );
return;
}
unless ( $dbh->{mock_can_fetch} ) {
$dbh->set_err( 1, "Cannot fetch" );
return;
}
$dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
my $tracker = $sth->FETCH('mock_my_history');
my $record = $tracker->next_record
or return;
if ( my @cols = $tracker->bind_cols() ) {
for my $i ( grep { ref $cols[$_] } 0 .. $#cols ) {
${ $cols[$i] } = $record->[$i];
}
}
return $record;
}
sub fetchrow_array {
my ($sth) = @_;
my $row = $sth->DBD::Mock::st::fetch();
return unless ref($row) eq 'ARRAY';
return @{$row};
}
sub fetchrow_arrayref {
my ($sth) = @_;
return $sth->DBD::Mock::st::fetch();
}
sub fetchrow_hashref {
my ( $sth, $name ) = @_;
my $dbh = $sth->{Database};
# handle any errors since we are grabbing
# from the tracker directly
unless ( $dbh->{mock_can_connect} ) {
$dbh->set_err( 1, "No connection present" );
return;
}
unless ( $dbh->{mock_can_fetch} ) {
$dbh->set_err( 1, "Cannot fetch" );
return;
}
$dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
# first handle the $name, it will default to NAME
$name ||= 'NAME';
# then fetch the names from the $sth (per DBI spec)
my $fields = $sth->FETCH($name);
# now check the tracker ...
my $tracker = $sth->FETCH('mock_my_history');
# and collect the results
if ( my $record = $tracker->next_record() ) {
my @values = @{$record};
return { map { $_ => shift(@values) } @{$fields} };
}
return undef;
}
#XXX Isn't this supposed to return an array of hashrefs? -RobK, 2007-10-15
sub fetchall_hashref {
my ( $sth, $keyfield ) = @_;
my $dbh = $sth->{Database};
# handle any errors since we are grabbing
# from the tracker directly
unless ( $dbh->{mock_can_connect} ) {
$dbh->set_err( 1, "No connection present" );
return;
}
unless ( $dbh->{mock_can_fetch} ) {
$dbh->set_err( 1, "Cannot fetch" );
return;
}
$dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
my $tracker = $sth->FETCH('mock_my_history');
my $rethash = {};
# get the name set by
my $name = $sth->{Database}->FETCH('FetchHashKeyName') || 'NAME';
my $fields = $sth->FETCH($name);
# check if $keyfield is not an integer
if ( !( $keyfield =~ /^-?\d+$/ ) ) {
my $found = 0;
# search for index of item that matches $keyfield
foreach my $index ( 0 .. scalar( @{$fields} ) ) {
if ( $fields->[$index] eq $keyfield ) {
$found++;
# now make the keyfield the index
$keyfield = $index;
# and jump out of the loop :)
last;
}
}
unless ($found) {
$dbh->set_err( 1, "Could not find key field '$keyfield'" );
return;
}
}
# now loop through all the records ...
while ( my $record = $tracker->next_record() ) {
# copy the values so as to preserve
# the original record...
my @values = @{$record};
# populate the hash
$rethash->{ $record->[$keyfield] } =
{ map { $_ => shift(@values) } @{$fields} };
}
return $rethash;
}
sub finish {
my ($sth) = @_;
$sth->FETCH('mock_my_history')->is_finished('yes');
}
sub rows {
my ($sth) = @_;
$sth->FETCH('mock_num_rows');
}
sub FETCH {
my ( $sth, $attrib ) = @_;
$sth->trace_msg("Fetching ST attribute '$attrib'\n");
my $tracker = $sth->{mock_my_history};
$sth->trace_msg( "Retrieved tracker: " . ref($tracker) . "\n" );
# NAME attributes
if ( $attrib eq 'NAME' ) {
return [ @{ $tracker->fields } ];
}
elsif ( $attrib eq 'NAME_lc' ) {
return [ map { lc($_) } @{ $tracker->fields } ];
}
elsif ( $attrib eq 'NAME_uc' ) {
return [ map { uc($_) } @{ $tracker->fields } ];
}
# NAME_hash attributes
elsif ( $attrib eq 'NAME_hash' ) {
my $i = 0;
return { map { $_ => $i++ } @{ $tracker->fields } };
}
elsif ( $attrib eq 'NAME_hash_lc' ) {
my $i = 0;
return { map { lc($_) => $i++ } @{ $tracker->fields } };
}
elsif ( $attrib eq 'NAME_hash_uc' ) {
my $i = 0;
return { map { uc($_) => $i++ } @{ $tracker->fields } };
}
# others
elsif ( $attrib eq 'NUM_OF_FIELDS' ) {
return $tracker->num_fields;
}
elsif ( $attrib eq 'NUM_OF_PARAMS' ) {
return $tracker->num_params;
}
elsif ( $attrib eq 'TYPE' ) {
my $num_fields = $tracker->num_fields;
return [ map { $DBI::SQL_VARCHAR } ( 0 .. $num_fields ) ];
}
elsif ( $attrib eq 'Active' ) {
return $tracker->is_active;
}
elsif ( $attrib !~ /^mock/ ) {
if ( $sth->{Database}->{mock_attribute_aliases} ) {
if (
exists ${ $sth->{Database}->{mock_attribute_aliases}->{st} }
{$attrib} )
{
my $mock_attrib =
$sth->{Database}->{mock_attribute_aliases}->{st}->{$attrib};
if ( ref($mock_attrib) eq 'CODE' ) {
return $mock_attrib->($sth);
}
else {
return $sth->FETCH($mock_attrib);
}
}
}
return $sth->SUPER::FETCH($attrib);
}
# now do our stuff...
if ( $attrib eq 'mock_my_history' ) {
return $tracker;
}
if ( $attrib eq 'mock_statement' ) {
return $tracker->statement;
}
elsif ( $attrib eq 'mock_params' ) {
return $tracker->bound_params;
}
elsif ( $attrib eq 'mock_records' ) {
return $tracker->return_data;
}
elsif ( $attrib eq 'mock_num_records' || $attrib eq 'mock_num_rows' ) {
return $tracker->num_rows;
}
elsif ( $attrib eq 'mock_current_record_num' ) {
return $tracker->current_record_num;
}
elsif ( $attrib eq 'mock_fields' ) {
return $tracker->fields;
}
elsif ( $attrib eq 'mock_is_executed' ) {
return $tracker->is_executed;
}
elsif ( $attrib eq 'mock_is_finished' ) {
return $tracker->is_finished;
}
elsif ( $attrib eq 'mock_is_depleted' ) {
return $tracker->is_depleted;
}
else {
die "I don't know how to retrieve statement attribute '$attrib'\n";
}
}
sub STORE {
my ( $sth, $attrib, $value ) = @_;
$sth->trace_msg("Storing ST attribute '$attrib'\n");
if ( $attrib =~ /^mock/ ) {
return $sth->{$attrib} = $value;
}
elsif ( $attrib =~ /^NAME/ ) {
# no-op...
return;
}
else {
$value ||= 0;
return $sth->SUPER::STORE( $attrib, $value );
}
}
sub DESTROY { undef }
1;
Jump to Line
Something went wrong with that request. Please try again.