pax_global_header00006660000000000000000000000064103162103070014503gustar00rootroot0000000000000052 comment=44cfba08ee891565faa3c52d1103799a74e5a5c2 DBIx-ContextualFetch-1.03/000075500000000000000000000000001031621030700153105ustar00rootroot00000000000000DBIx-ContextualFetch-1.03/Changes000064400000000000000000000005321031621030700166030ustar00rootroot00000000000000Revision history 1.03 Mon Dec 27 2004 - Revert to DBD::SQLite (rather than SQLite2) in tests - no warnings 'uninitialized' 1.02 Mon Dec 27 2004 - Fix double execute bug in tests 1.01 Mon Mar 15 2004 - Reintroduce workaround for local $sth->{Taint} leaking (Thanks to Colm Dougan) 1.00 Sun Mar 14 2004 - Created this from Ima::DBI DBIx-ContextualFetch-1.03/MANIFEST000064400000000000000000000002641031621030700164430ustar00rootroot00000000000000Changes lib/DBIx/ContextualFetch.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) README t/01.t t/pod-coverage.t t/pod.t DBIx-ContextualFetch-1.03/MANIFEST.SKIP000064400000000000000000000001641031621030700172070ustar00rootroot00000000000000^aegis.log ^config ^build ,D$ ^Makefile$ ^pm_to_blib ^\. ~$ \.ERR$ \.old$ \.bak$ \.swp$ \.tdy$ ^blib/ ^MakeMaker-\d DBIx-ContextualFetch-1.03/META.yml000064400000000000000000000006241031621030700165630ustar00rootroot00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: DBIx-ContextualFetch version: 1.03 version_from: lib/DBIx/ContextualFetch.pm installdirs: site requires: DBI: 1.35 Test::More: 0.11 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 DBIx-ContextualFetch-1.03/Makefile.PL000064400000000000000000000004571031621030700172700ustar00rootroot00000000000000use ExtUtils::MakeMaker; WriteMakefile( AUTHOR => 'Tony Bowden ', NAME => 'DBIx::ContextualFetch', ABSTRACT_FROM => 'lib/DBIx/ContextualFetch.pm', VERSION_FROM => 'lib/DBIx/ContextualFetch.pm', PREREQ_PM => { 'DBI' => 1.35, 'Test::More' => 0.11, }, ); DBIx-ContextualFetch-1.03/README000064400000000000000000000074721031621030700162020ustar00rootroot00000000000000NAME DBIx::ContextualFetch - Add contextual fetches to DBI SYNOPSIS my $dbh = DBI->connect(...., { RootClass => "DBIx::ContextualFetch" }); # Modified statement handle methods. my $rv = $sth->execute; my $rv = $sth->execute(@bind_values); my $rv = $sth->execute(\@bind_values, \@bind_cols); # In addition to the normal DBI sth methods... my $row_ref = $sth->fetch; my @row = $sth->fetch; my $row_ref = $sth->fetch_hash; my %row = $sth->fetch_hash; my $rows_ref = $sth->fetchall; my @rows = $sth->fetchall; my $rows_ref = $sth->fetchall_hash; my @tbl = $sth->fetchall_hash; DESCRIPTION It always struck me odd that DBI didn't take much advantage of Perl's context sensitivity. DBIx::ContextualFetch redefines some of the various fetch methods to fix this oversight. It also adds a few new methods for convenience (though not necessarily efficiency). SET-UP my $dbh = DBIx::ContextualFetch->connect(@info); my $dbh = DBI->connect(@info, { RootClass => "DBIx::ContextualFetch" }); To use this method, you can either make sure that everywhere you normall call DBI->connect() you either call it on DBIx::ContextualFetch, or that you pass this as your RootClass. After this DBI will Do The Right Thing and pass all its calls through us. EXTENSIONS execute $rv = $sth->execute; $rv = $sth->execute(@bind_values); $rv = $sth->execute(\@bind_values, \@bind_cols); execute() is enhanced slightly: If called with no arguments, or with a simple list, execute() operates normally. When when called with two array references, it performs the functions of bind_param, execute and bind_columns similar to the following: $sth->execute(@bind_values); $sth->bind_columns(undef, @bind_cols); In addition, execute will accept tainted @bind_values. I can't think of what a malicious user could do with a tainted bind value (in the general case. Your application may vary.) Thus a typical idiom would be: $sth->execute([$this, $that], [\($foo, $bar)]); Of course, this method provides no way of passing bind attributes through to bind_param or bind_columns. If that is necessary, then you must perform the bind_param, execute, bind_col sequence yourself. fetch $row_ref = $sth->fetch; @row = $sth->fetch; A context sensitive version of fetch(). When in scalar context, it will act as fetchrow_arrayref. In list context it will use fetchrow_array. fetch_hash $row_ref = $sth->fetch_hash; %row = $sth->fetch_hash; A modification on fetchrow_hashref. When in scalar context, it acts just as fetchrow_hashref() does. In list context it returns the complete hash. fetchall $rows_ref = $sth->fetchall; @rows = $sth->fetchall; A modification on fetchall_arrayref. In scalar context it acts as fetchall_arrayref. In list it returns an array of references to rows fetched. fetchall_hash $rows_ref = $sth->fetchall_hash; @rows = $sth->fetchall_hash; A mating of fetchall_arrayref() with fetchrow_hashref(). It gets all rows from the hash, each as hash references. In scalar context it returns a reference to an array of hash references. In list context it returns a list of hash references. ORIGINAL AUTHOR Michael G Schwern as part of Ima::DBI CURRENT MAINTAINER Tony Bowden LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. SEE ALSO DBI. Ima::DBI. Class::DBI. DBIx-ContextualFetch-1.03/lib/000075500000000000000000000000001031621030700160565ustar00rootroot00000000000000DBIx-ContextualFetch-1.03/lib/DBIx/000075500000000000000000000000001031621030700166445ustar00rootroot00000000000000DBIx-ContextualFetch-1.03/lib/DBIx/ContextualFetch.pm000064400000000000000000000130641031621030700223060ustar00rootroot00000000000000package DBIx::ContextualFetch; $VERSION = '1.03'; use strict; use warnings; no warnings 'uninitialized'; use base 'DBI'; package DBIx::ContextualFetch::db; use base 'DBI::db'; package DBIx::ContextualFetch::st; use base 'DBI::st'; sub execute { my ($sth) = shift; my $rv; # Allow $sth->execute(\@param, \@cols) and # $sth->execute(undef, \@cols) syntax. if ( @_ == 2 and (!defined $_[0] || ref $_[0] eq 'ARRAY') and ref $_[1] eq 'ARRAY') { my ($bind_params, $bind_cols) = @_; $rv = $sth->_untaint_execute(@$bind_params); $sth->SUPER::bind_columns(@$bind_cols); } else { $sth->_disallow_references(@_); $rv = $sth->_untaint_execute(@_); } return $rv; } sub _disallow_references { my $self = shift; foreach (@_) { next unless ref $_; next if overload::Method($_, q{""}); next if overload::Method($_, q{0+}); die "Cannot call execute with a reference ($_)\n"; } } # local $sth->{Taint} leaks in old perls :( sub _untaint_execute { my $sth = shift; my $old_value = $sth->{Taint}; $sth->{Taint} = 0; my $ret = $sth->SUPER::execute(@_); $sth->{Taint} = $old_value; return $ret; } sub fetch { my ($sth) = shift; return wantarray ? $sth->SUPER::fetchrow_array : $sth->SUPER::fetchrow_arrayref; } sub fetch_hash { my ($sth) = shift; my $row = $sth->SUPER::fetchrow_hashref; return unless defined $row; return wantarray ? %$row : $row; } sub fetchall { my ($sth) = shift; my $rows = $sth->SUPER::fetchall_arrayref; return wantarray ? @$rows : $rows; } # There may be some code in DBI->fetchall_arrayref, but its undocumented. sub fetchall_hash { my ($sth) = shift; my (@rows, $row); push @rows, $row while ($row = $sth->SUPER::fetchrow_hashref); return wantarray ? @rows : \@rows; } sub select_row { my ($sth, @args) = @_; $sth->execute(@args); my @row = $sth->fetchrow_array; $sth->finish; return @row; } sub select_col { my ($sth, @args) = @_; my (@row, $cur); $sth->execute(@args); $sth->bind_col(1, \$cur); push @row, $cur while $sth->fetch; $sth->finish; return @row; } sub select_val { my ($sth, @args) = @_; return ($sth->select_row(@args))[0]; } return 1; __END__ =head1 NAME DBIx::ContextualFetch - Add contextual fetches to DBI =head1 SYNOPSIS my $dbh = DBI->connect(...., { RootClass => "DBIx::ContextualFetch" }); # Modified statement handle methods. my $rv = $sth->execute; my $rv = $sth->execute(@bind_values); my $rv = $sth->execute(\@bind_values, \@bind_cols); # In addition to the normal DBI sth methods... my $row_ref = $sth->fetch; my @row = $sth->fetch; my $row_ref = $sth->fetch_hash; my %row = $sth->fetch_hash; my $rows_ref = $sth->fetchall; my @rows = $sth->fetchall; my $rows_ref = $sth->fetchall_hash; my @tbl = $sth->fetchall_hash; =head1 DESCRIPTION It always struck me odd that DBI didn't take much advantage of Perl's context sensitivity. DBIx::ContextualFetch redefines some of the various fetch methods to fix this oversight. It also adds a few new methods for convenience (though not necessarily efficiency). =head1 SET-UP my $dbh = DBIx::ContextualFetch->connect(@info); my $dbh = DBI->connect(@info, { RootClass => "DBIx::ContextualFetch" }); To use this method, you can either make sure that everywhere you normall call DBI->connect() you either call it on DBIx::ContextualFetch, or that you pass this as your RootClass. After this DBI will Do The Right Thing and pass all its calls through us. =head1 EXTENSIONS =head2 execute $rv = $sth->execute; $rv = $sth->execute(@bind_values); $rv = $sth->execute(\@bind_values, \@bind_cols); execute() is enhanced slightly: If called with no arguments, or with a simple list, execute() operates normally. When when called with two array references, it performs the functions of bind_param, execute and bind_columns similar to the following: $sth->execute(@bind_values); $sth->bind_columns(undef, @bind_cols); In addition, execute will accept tainted @bind_values. I can't think of what a malicious user could do with a tainted bind value (in the general case. Your application may vary.) Thus a typical idiom would be: $sth->execute([$this, $that], [\($foo, $bar)]); Of course, this method provides no way of passing bind attributes through to bind_param or bind_columns. If that is necessary, then you must perform the bind_param, execute, bind_col sequence yourself. =head2 fetch $row_ref = $sth->fetch; @row = $sth->fetch; A context sensitive version of fetch(). When in scalar context, it will act as fetchrow_arrayref. In list context it will use fetchrow_array. =head2 fetch_hash $row_ref = $sth->fetch_hash; %row = $sth->fetch_hash; A modification on fetchrow_hashref. When in scalar context, it acts just as fetchrow_hashref() does. In list context it returns the complete hash. =head2 fetchall $rows_ref = $sth->fetchall; @rows = $sth->fetchall; A modification on fetchall_arrayref. In scalar context it acts as fetchall_arrayref. In list it returns an array of references to rows fetched. =head2 fetchall_hash $rows_ref = $sth->fetchall_hash; @rows = $sth->fetchall_hash; A mating of fetchall_arrayref() with fetchrow_hashref(). It gets all rows from the hash, each as hash references. In scalar context it returns a reference to an array of hash references. In list context it returns a list of hash references. =head1 ORIGINAL AUTHOR Michael G Schwern as part of Ima::DBI =head1 CURRENT MAINTAINER Tony Bowden =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L. L. L. DBIx-ContextualFetch-1.03/t/000075500000000000000000000000001031621030700155535ustar00rootroot00000000000000DBIx-ContextualFetch-1.03/t/01.t000064400000000000000000000050301031621030700161560ustar00rootroot00000000000000#!/usr/bin/perl -w use strict; use Test::More; BEGIN { eval "use DBD::SQLite"; plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 17); } use File::Temp qw/tempfile/; my (undef, $DB) = tempfile(); my @DSN = ( "dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 1, RootClass => "DBIx::ContextualFetch" }); my $dbh = DBI->connect(@DSN); $dbh->do("CREATE TABLE foo (id INTEGER, name TEXT)"); my $insert = $dbh->prepare("INSERT INTO foo VALUES (?, ?)"); $insert->execute(1, "Fred"); $insert->execute(2, "Barney"); sub make_sth { my $sql = shift; my $sth = $dbh->prepare($sql); return $sth; } { # fetch (my $sth = make_sth("SELECT * FROM foo ORDER BY id"))->execute; my @got1 = $sth->fetch; is $got1[1], "Fred", 'fetch @'; my $got2 = $sth->fetch; is $got2->[1], "Barney", 'fetch $'; } { # Fetch Hash (my $sth = make_sth("SELECT * FROM foo ORDER BY id"))->execute; my %got1 = $sth->fetch_hash; is $got1{name}, "Fred", 'fetch_hash %'; my $got2 = $sth->fetch_hash; is $got2->{name}, "Barney", 'fetch_hash $'; my %got3 = eval { $sth->fetch_hash }; is keys %got3, 0, "Nothing at the end"; is $@, "", "And no error"; } { # fetchall @ (my $sth = make_sth("SELECT * FROM foo ORDER BY id"))->execute; my @got = $sth->fetchall; is $got[1]->[1], "Barney", 'fetchall @'; } { # fetchall $ (my $sth = make_sth("SELECT * FROM foo ORDER BY id"))->execute; my $got = $sth->fetchall; is $got->[1]->[1], "Barney", 'fetchall $'; } { # fetchall_hash @ (my $sth = make_sth("SELECT * FROM foo ORDER BY id"))->execute; my @got = $sth->fetchall_hash; is $got[1]->{name}, "Barney", 'fetchall_hash @'; } { # fetchall_hash $ (my $sth = make_sth("SELECT * FROM foo ORDER BY id"))->execute; my $got = $sth->fetchall_hash; is $got->[1]->{name}, "Barney", 'fetchall_hash @'; } { # select_row my $sth = make_sth("SELECT * FROM foo WHERE id = ?"); my ($id, $name) = $sth->select_row(1); is $name, "Fred", "select_row"; } { # select_col my $sth = make_sth("SELECT name FROM foo where id > ? ORDER BY id"); my @names = $sth->select_col(0); is $names[1], "Barney", "select_col"; } { # select_val my $sth = make_sth("SELECT name FROM foo where id = ?"); my $name = $sth->select_val(1); is $name, "Fred", "select_val"; } { # Execute binding my $sth = make_sth("SELECT * FROM foo WHERE id > ? ORDER BY id"); $sth->execute([0], [ \my ($id, $name) ]); $sth->fetch; is $id, 1, "bound id 1"; is $name, "Fred", "name = Fred"; $sth->fetch; is $id, 2, "bound id 2"; is $name, "Barney", "name = Barney"; } DBIx-ContextualFetch-1.03/t/pod-coverage.t000064400000000000000000000002411031621030700203100ustar00rootroot00000000000000use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); DBIx-ContextualFetch-1.03/t/pod.t000064400000000000000000000002011031621030700165130ustar00rootroot00000000000000use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok();