Luke Ross

DBIx::InterpolationBinding

5 releases git clone https://lukeross.name/projects/dbix-interpolationbinding.git/

Perl extension for turning perl double-quote string interpolation into DBI bind parameters.

Commit 33d1456010c4a789f6b3f84e2bebefbd3fb7af3b

New version git-svn-id: file:///home/lukeross/ToDo/code-subversion/perl-SQL-InterpolationBinding@121 3208c2a6-1f24-0410-bbd8-cb17f2cc2c65

Committed 9 Apr 2007 by lukeross

Changes

@@ -1,5 +1,10 @@
 Revision history for Perl extension SQL::InterpolationBinding.
 
+0.02  Mon Apr 09 14:48:34 2007
+	- Moved dbi_exec to $dbh->execute
+	- Used DBI set_err for error reporting
+	- Improved test suite
+
 0.01  Sat Dec 16 08:47:52 2006
 	- original version
 


MANIFEST

@@ -2,6 +2,7 @@ Changes
 Makefile.PL
 MANIFEST
 README
-t/SQL-InterpolationBinding.t
+t/01-overloading.t
+t/02-dbi.t
 lib/SQL/InterpolationBinding.pm
 META.yml                                 Module meta-data


Makefile.PL

@@ -5,7 +5,7 @@ use ExtUtils::MakeMaker;
 WriteMakefile(
     NAME              => 'SQL::InterpolationBinding',
     VERSION_FROM      => 'lib/SQL/InterpolationBinding.pm', # finds $VERSION
-    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
+    PREREQ_PM         => { DBI => 0 },
     ABSTRACT_FROM     => 'lib/SQL/InterpolationBinding.pm', # retrieve abstract from module
     AUTHOR            => 'Luke Ross <luke@lukeross.name>'
 );


README

@@ -1,4 +1,4 @@
-SQL-InterpolationBinding version 0.01
+SQL-InterpolationBinding version 0.02
 =====================================
 
 This module is provides a method to prepare and execute SQL statements
@@ -21,10 +21,12 @@ DEPENDENCIES
 This module requires these other modules and libraries:
 
   Perl 5.005_03 or greater
+  DBI
+  DBD::DBM for some of the tests
 
 COPYRIGHT AND LICENCE
 
-Copyright (C) 2006 by Luke Ross
+Copyright (C) 2006-2007 by Luke Ross
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself, either Perl version 5.005 or,


lib/SQL/InterpolationBinding.pm

@@ -4,39 +4,42 @@ package SQL::InterpolationBinding;
 
 use 5.005;
 use strict;
-use vars qw($VERSION @ISA @EXPORT $DEBUG);
+use vars qw($VERSION $DEBUG);
 
-use overload	'""'		=> \&_convert_object_to_string,
-		'.'		=> \&_append_item_to_object,
-		'fallback'	=> 1;
+use overload '""'       => \&_convert_object_to_string,
+             '.'        => \&_append_item_to_object,
+             'fallback' => 1;
+require DBI;
 
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(dbi_exec);
-
-$VERSION = '0.01';
+$VERSION = '0.02';
 
 $DEBUG = 0;
 
 sub import {
 	overload::constant 'q' => \&_prepare_object_from_string;
-	SQL::InterpolationBinding->export_to_level(1, @_);
+
+	# Bind the execute method into the DBI namespace
+	# We do it twice to avoid a tedious warning
+	*DBI::db::execute = \&dbi_exec;
+	*DBI::db::execute = \&dbi_exec;
 }
 
 sub unimport {
 	overload::remove_constant 'q';
-	SUPER->unimport(@_);
 }
 
 sub dbi_exec {
-	my ($dbi, $sql, @params) = @_;
+	my ($dbi, $sql) = @_;
 
-	($sql, @params) = _create_sql_and_params($sql, @params);
+	return $dbi->set_err(1,
+		'\$dbh->execute can only be used with a magic string.')
+		unless (ref $sql and $sql->isa(__PACKAGE__));
+	($sql, my @params) = _create_sql_and_params($sql);
 
-	print "DBI::prepare($sql)\nDBI::execute(", join(", ",
+	print STDERR "DBI::prepare($sql)\nDBI::execute(", join(", ",
 		@params) , ")\n" if $DEBUG;
 	my $sth = $dbi->prepare($sql) or return;
-	$sth->execute($sql, @params) or return;
+	$sth->execute(@params) or return;
 	return $sth;
 }
 
@@ -54,17 +57,23 @@ sub _create_sql_and_params {
 
 sub _prepare_object_from_string {
 	my (undef, $string, $mode) = @_;
+
+	# We only want to affect double-quoted strings
 	return $string unless ($mode eq "qq");
+
+	# Make an object out of the string
 	my $self = {
 		string => $string,
 		sql_string => $string,
 		bind_params => [ ]
 	};
-	return bless $self, "SQL::InterpolationBinding";
+	return bless $self => __PACKAGE__;
 }
 
 sub _convert_object_to_string {
-	my $self = shift;
+	my ($self) = @_;
+
+	# We need a string for this (eg. to print or use outside DBI)
 	return $self->{string};
 }
 
@@ -103,7 +112,8 @@ sub _append_item_to_object {
 		push @{ $new_hash->{bind_params} }, $string;
 	}
 
-	return bless $new_hash, ref($self);
+	# Make the new thing an object
+	return bless $new_hash => ref($self);
 }
 
 1;
@@ -120,7 +130,7 @@ string interpolation into DBI bind parameters.
 
   {
     use SQL::InterpolationBinding;
-    my $sth = dbi_exec($dbh, "SELECT * FROM table WHERE id=$id");
+    my $sth = $dbh->execute("SELECT * FROM table WHERE id=$id");
   }
 
   my $result = $sth->fetchrow_hashref();
@@ -138,10 +148,17 @@ the BUGS section below.
 
 =head2 EXPORT
 
-=head3 dbi_exec($dbh, $sql);
+=head3 $dbh->execute($sql);
+
+Rather rudely, this module exports an execute method into class DBI::db,
+so you can call execute() on DBI database handles.
+
+This method only accepts overloaded strings (ie. those created when
+SQL::InterpolationBinding is in force) - this makes it harder to shoot
+yourself in the foot by using it with strings that have been
+interpolated in an unsafe way.
 
-Prepare and execute the SQL query $sql on the DBI connection $dbh. Returns a
-DBI statement handle, or undef on failure.
+Returns a DBI statement handle, or undef on failure.
 
 =head3 $SQL::InterpolationBinding::DEBUG
 
@@ -198,7 +215,7 @@ Luke Ross, E<lt>luke@lukeross.nameE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2006 by Luke Ross
+Copyright (C) 2006-2007 by Luke Ross
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself, either Perl version 5.8.5 or,


t/SQL-InterpolationBinding.t -> t/01-overloading.t

@@ -1,10 +1,8 @@
 # Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl SQL-InterpolationBinding.t'
+# `make test'. After `make install' it should work as `perl 01-overloading.t'
 
 #########################
 
-# change 'tests => 1' to 'tests => last_test_to_print';
-
 use Test;
 BEGIN { plan tests => 5 };
 use SQL::InterpolationBinding;
@@ -12,9 +10,6 @@ ok(1); # If we made it this far, we're ok.
 
 #########################
 
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-
 sub array_eq {
 	my $list1 = shift;
 	my $list2 = shift;
@@ -46,14 +41,14 @@ ok(array_eq(
 
 {
 
-no SQL::InterpolationBinding;
+	no SQL::InterpolationBinding;
 
-ok(array_eq(
-	[ 'SELECT * FROM table WHERE a=1 AND b=hello' ],
-	[ SQL::InterpolationBinding::_create_sql_and_params(
-		"SELECT * FROM table WHERE a=$a AND b=$b"
-	) ]
-), 1, "4: Lexical scope only");
+	ok(array_eq(
+		[ 'SELECT * FROM table WHERE a=1 AND b=hello' ],
+		[ SQL::InterpolationBinding::_create_sql_and_params(
+			"SELECT * FROM table WHERE a=$a AND b=$b"
+		) ]
+	), 1, "4: Lexical scope only");
 
 }
 


t/02-dbi.t

@@ -0,0 +1,75 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 02-dbi.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+my $tests;
+BEGIN { $tests = 8; plan tests => $tests };
+
+my $dbh;
+eval 'use DBI; $dbh = DBI->connect("dbi:DBM:");';
+unless($dbh) {
+	for(1 .. $tests) {
+		skip("Skip DBI, DBD::DBM not available ($@)");
+	}
+} else {
+
+$dbh->{RaiseError} = 1;
+# Set up environment
+$dbh->do("CREATE TABLE fruit (dKey INT, dVal VARCHAR(10))")
+	or die($dbh->errstr());
+
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+my $a = 1;
+my $b = 2;
+my $c = 3;
+my $d = 'oranges';
+my $e = q('";);
+my $f = 'to delete';
+my $g = 'apples';
+
+{
+use SQL::InterpolationBinding;
+
+# Try an insert
+ok($dbh->execute("INSERT INTO fruit VALUES ($a,$d)"));
+ok($dbh->execute("INSERT INTO fruit VALUES ($b,$e)"));
+ok($dbh->execute("INSERT INTO fruit VALUES ($c,$f)"));
+
+# And an update
+$sth = $dbh->execute("UPDATE fruit SET dVal=$g WHERE dKey=$b");
+ok($sth and $sth->rows == 1);
+$sth->finish if $sth;
+
+# And a delete
+$sth = $dbh->execute("DELETE FROM fruit WHERE dVal=$f");
+ok($sth and $sth->rows == 1);
+
+# Try a select
+my $row;
+my $sth = $dbh->execute("SELECT * FROM fruit WHERE dVal = $g");
+ok($sth and $sth->rows == 1 and $row = $sth->fetchrow_hashref and
+   $row->{dKey} eq $b and $row->{dVal} eq $g);
+$sth->finish if $sth;
+
+}
+
+# Can't work outside scope? - the eval should fail as the string isn't
+# overloaded.
+eval {
+	$dbh->{PrintError} = 0;
+	my $sth = $dbh->execute("SELECT * FROM fruit WHERE dVal = $c");
+	$sth->finish;
+};
+ok($@);
+
+# Cleanup
+$dbh->do("DROP TABLE fruit");
+
+}