Mark Lawrence wrote:
On Wed Mar 12, 2008 at 04:20:16PM +0000, Matt Lawrence wrote:
Mark Lawrence wrote:
On Wed Mar 12, 2008 at 03:37:33PM +0000, Matt Lawrence wrote:
Mark Lawrence wrote:
On Wed Mar 12, 2008 at 12:30:14PM +0000, Matt Lawrence wrote:
I guess I could add a failsafe to trap unprintable values still present
after quote() and replace them with dummy values as in your previous
example.
# Store quoted versions of the values
my @bind_vals = map {
$_ = $storage->dbh->quote($_->[1], shift @$datatypes);
$_ = $storage->dbh->quote('*BINARY DATA*') if /[^[:print:]\n\t]/;
$_;
} @$bind;
You don't need to care about newlines or tabs (in fact if you
specifically search for that you might not find what you are looking
for), you just want to know if it contains non-printable data:
$_ = $storage->dbh->quote('*BINARY DATA*') if /[^[:print:]]/;
Newlines and tabs won't mess up terminals and they are not matched by
[:print:].
Take another look at what you are doing above. In plain english you are
looking for an unprintable character followed by a newline followed by a
tab. What happens if your data is "???ABC\n\t" where ??? are the
unprintable characters? Ie, the data is not terminated by non-printables.
That won't match your regex. And the newline and tab are anyway not
being replaced in that statement - you are setting the whole string to
'*BINARY DATA*' (which btw probably doesn't need to be quoted by DBI).
Nope, the \n\t was inside the (negated) character class. It matches if
the string contains any character which is not printable, a newline or a
tab.
Sorry, my bad. However I'm still wondering why you want to replace text
that contains newlines or tabs by the string BINARY DATA. They are
certainly printable. The type of queries that I typically want to debug
are well and truly already longer than a single line anyway.
Indeed they are printable, which is why it's a shame that [:print:]
doesn't match them.
My code ensures that values with newlines or tabs *are* treated as
printable.
$ perl -le 'print "foo" =~ /\A[[:print:]]+\z/ ? 1 : 0'
1
$ perl -le 'print "foo\n" =~ /\A[[:print:]]+\z/ ? 1 : 0'
0
In fact, I really should have used /[^[:graph:][:space:]]/ to find
unprintable characters, CRLF is printable too.
man perlre says:
print
Any alphanumeric or punctuation (special) character or the space
character.
I take your point about the quoting, there's no point trying to make
something keep it being valid SQL
How about this:
my @bind_vals = map {
my $data_type = shift @$datatypes;
$_[1] =~ /[^[:print:]\n\t]/ ? '*BINARY DATA*' :
$storage->dbh->quote($_[1], $data_type)
} @$bind;
[disclaimer: I am not a contributor to CDBI and don't know the standards]
but how about this for clarity:
my @bind_vals = map {
my $data_type = shift @$datatypes;
$_[1] =~ /[^[:print:]]/
? '*BINARY DATA*'
: $storage->dbh->quote($_[1], $data_type)
} @$bind;
Yeah, I'd already split it onto different lines since sending the last
email. Full patch attached.
Matt
diff -Nru DBIx-Class-0.08008/lib/DBIx/Class/ResultSet.pm
DBIx-Class-0.08008-mine/lib/DBIx/Class/ResultSet.pm
--- DBIx-Class-0.08008/lib/DBIx/Class/ResultSet.pm 2007-10-31
21:08:51.000000000 +0000
+++ DBIx-Class-0.08008-mine/lib/DBIx/Class/ResultSet.pm 2008-03-11
14:22:46.000000000 +0000
@@ -2107,6 +2107,35 @@
}
}
+=head2 as_sql
+
+ ($sql, @bind_values) = $rs->as_sql()
+
+Returns a representation of the resultset as a select query. Values for any
+placeholders in the query are passed back.
+
+If you want to execute the query, do not use this method. Use L</next> or
+L</all> for that.
+
+See L<DBIx::Class::Cursor/as_sql> for more information.
+
+=head2 as_static_sql
+
+ $sql = $rs->as_static_sql([ \%datatypes | [EMAIL PROTECTED] ])
+
+Returns a representation of the resultset as a select query with all
+placeholders replaced with quoted values.
+
+If you want to execute the query, do not use this method. Use L</next> or
+L</all> for that.
+
+See L<DBIx::Class::Cursor/as_static_sql> for more information.
+
+=cut
+
+sub as_sql { shift->cursor->as_sql(@_) }
+sub as_static_sql { shift->cursor->as_static_sql(@_) }
+
=head2 throw_exception
See L<DBIx::Class::Schema/throw_exception> for details.
diff -Nru DBIx-Class-0.08008/lib/DBIx/Class/Storage/DBI/Cursor.pm
DBIx-Class-0.08008-mine/lib/DBIx/Class/Storage/DBI/Cursor.pm
--- DBIx-Class-0.08008/lib/DBIx/Class/Storage/DBI/Cursor.pm 2007-08-11
22:07:58.000000000 +0100
+++ DBIx-Class-0.08008-mine/lib/DBIx/Class/Storage/DBI/Cursor.pm
2008-03-12 17:33:52.000000000 +0000
@@ -49,6 +49,114 @@
return bless ($new, $class);
}
+=head2 as_sql
+
+ ($sql, @bind_values) = $cursor->as_sql([ \%datatypes ])
+
+Returns the query behind the cursor as a SQL select statement, with
+placeholders left intact and the relevant values passed back as an array.
+
+This method is intended for debugging and informational purposes only, it is
+not recommended that you use it to query the database.
+
+=cut
+
+# Get SQL and raw bind data
+sub _as_sql {
+ my $self = shift;
+ my $storage = $self->{storage};
+
+ my $sql_maker = $storage->sql_maker;
+ local $sql_maker->{for};
+
+ my @args = $storage->_select_args(@{$self->{args}});
+
+ return $storage->_prep_for_execute(@args[0 .. 2], [EMAIL PROTECTED] ..
$#args]]);
+}
+
+sub as_sql {
+ my $self = shift;
+
+ my ($sql, $bind) = $self->_as_sql;
+
+ # Pass back the values only
+ my @bind_vals = map { $_->[1] } @$bind;
+
+ return ($sql, @bind_vals);
+}
+
+=head2 as_static_sql
+
+ $sql = $cursor->as_static_sql([ \%datatypes | [EMAIL PROTECTED] ])
+
+Returns the SQL for the cursor as complete SQL, with placeholders replaced with
+relevant values, quoted by DBI's L<quote|DBI/quote> method.
+
+If a reference is passed as an argument it is used to ascertain the data type
+to pass to L<quote()|DBI/quote>. Array refs are passed in order for the
+positional parameters, hashrefs are mapped to columns by name.
+
+Warnings are issued if there is a mismatch between the number of placeholders
+and the number of bind values.
+
+Passing this SQL to a database is not recommended, certainly not
+programmatically. It should be used for informational or debugging purposes
+only.
+
+=cut
+
+sub as_static_sql {
+ my ($self, $datatypes) = @_;
+ my $storage = $self->{storage};
+
+ my ($sql, $bind) = $self->_as_sql;
+
+ if (ref $datatypes eq 'HASH') {
+ $datatypes = [ map { $datatypes->{$_->[0]} } @$bind ];
+ }
+ elsif (ref $datatypes ne 'ARRAY') {
+ $datatypes = [];
+ }
+
+ # Store quoted versions of the values
+ #
+ my @bind_vals = map {
+ my $datatype = shift @$datatypes;
+ defined $_->[1] && $_->[1] =~ /[^[:graph:][:space:]]/
+ ? '*BINARY DATA*'
+ : $storage->dbh->quote($_->[1], $datatype)
+ } @$bind;
+
+ # Replace placeholders in the SQL string directly
+ # Are there any other possible placeholders other than '?'
+ $sql =~ s/(\?)/shift @bind_vals || $1/ge;
+
+ # Check for a mismatch in the number of placeholders
+ if (my $extra = $sql =~ y/\?/\?/) {
+ warn "$extra extra placeholder", $extra==1?'':'s', " in SQL";
+ }
+ elsif (@bind_vals) {
+ warn @bind_vals." extra bind parameter", @bind_vals==1?'':'s';
+ }
+
+ return $sql;
+}
+
+=head2 bind_names
+
+ @bind_names = $cursor->bind_names()
+
+Returns the names of the bind parameters in the query, to help with mapping
+data types to named columns in as_static_sql.
+
+=cut
+
+sub bind_names {
+ my $self = shift;
+ my ($sql, $bind) = $self->_as_sql;
+ return map { $_->[0] } @$bind;
+}
+
=head2 next
=over 4
diff -Nru DBIx-Class-0.08008/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class-0.08008-mine/lib/DBIx/Class/Storage/DBI.pm
--- DBIx-Class-0.08008/lib/DBIx/Class/Storage/DBI.pm 2007-10-07
20:02:22.000000000 +0100
+++ DBIx-Class-0.08008-mine/lib/DBIx/Class/Storage/DBI.pm 2008-01-09
14:28:31.000000000 +0000
@@ -925,6 +925,10 @@
sub _prep_for_execute {
my ($self, $op, $extra_bind, $ident, $args) = @_;
+ if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+ $ident = $ident->from();
+ }
+
my ($sql, @bind) = $self->sql_maker->$op($ident, @$args);
unshift(@bind,
map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
@@ -970,10 +974,6 @@
sub _dbh_execute {
my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
- if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
- $ident = $ident->from();
- }
-
my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, [EMAIL
PROTECTED]);
$self->_query_start( $sql, @$bind );
@@ -1096,6 +1096,13 @@
}
sub _select {
+ my $self = shift;
+ my $sql_maker = $self->sql_maker;
+ local $sql_maker->{for};
+ return $self->_execute($self->_select_args(@_));
+}
+
+sub _select_args {
my ($self, $ident, $select, $condition, $attrs) = @_;
my $order = $attrs->{order_by};
@@ -1103,9 +1110,8 @@
$order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
}
- my $for = delete $attrs->{for};
- my $sql_maker = $self->sql_maker;
- local $sql_maker->{for} = $for;
+ # This should always be localised in containing scope.
+ $self->sql_maker->{for} = delete $attrs->{for};
if (exists $attrs->{group_by} || $attrs->{having}) {
$order = {
@@ -1125,7 +1131,7 @@
push @args, $attrs->{rows}, $attrs->{offset};
}
- return $self->_execute(@args);
+ return @args;
}
sub source_bind_attributes {
diff -Nru DBIx-Class-0.08008/t/as_sql.t DBIx-Class-0.08008-mine/t/as_sql.t
--- DBIx-Class-0.08008/t/as_sql.t 1970-01-01 01:00:00.000000000 +0100
+++ DBIx-Class-0.08008-mine/t/as_sql.t 2008-03-12 17:40:00.000000000 +0000
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use lib qw( t/lib );
+use DBICTest;
+
+my $schema = DBICTest->init_schema;
+
+# BooksInLibrary has a default where clause with a placeholder
+my $rs = $schema->resultset('BooksInLibrary')->search({
+ owner => 1,
+ title => { '!=' => undef }, # IS NOT NULL (no placeholder)
+});
+
+my ($sql, @bind) = eval { $rs->as_sql };
+ok(!$@, 'as_sql lives') or diag $@;
+
+like($sql, qr(^\s*select\s+)i, 'as_sql output starts with select');
+
+# owner and source should result in parameters, title should not
+# The order of parameters might vary
+my %bind = map { $_ => 1 } @bind;
+is_deeply(\%bind, { 1 => 1, 'Library' => 1 }, 'bind_values as expected');
+
+$sql = eval { $rs->as_static_sql };
+ok(!$@, 'as_static_sql lives');
+like($sql, qr(^\s*select\s+)i, 'as_static_sql starts with select');
+like(
+ $sql, qr(\bsource\s*=\s*'Library'),
+ 'as_static_sql contains quoted source condition'
+);
+
+my @names = $rs->cursor->bind_names;
+is(@names, 2, 'Got 2 bind names');
+
+# hash for membership checking, order may not be predictable
+my %names = map { $_ => 1 } @names;
+my %expect = map { $_ => 1 } qw( owner source );
+is_deeply(\%names, \%expect, 'bind_names as expected');
+
+$rs = $rs->search({
+ title => "Unprintable\a\0",
+});
+
+like($rs->as_static_sql, qr(\*BINARY DATA\*), 'unprintable data is replaced');
+
+# TODO:
+ # test quoting different data types in as_static_sql
+ # Exception tests for mismatched query parameters - is this even possible?
+
+
_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/[EMAIL PROTECTED]
