X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FImaDBI.pm;h=10270b84fa6270e87f79fe2fe3a4ac08980df7ce;hb=8d73fcd44e0441f0252744be32bada6816c5ff6b;hp=49fc1e01c2a930543a9668d6b56ee5f6eea8f456;hpb=d4daee7b54e38e4b3d3d0a77759bddc1a4ede6e5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm index 49fc1e0..10270b8 100644 --- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm +++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm @@ -4,7 +4,7 @@ package # hide from PAUSE use strict; use warnings; use DBIx::ContextualFetch; -use Sub::Name (); +use DBIx::Class::_Util qw(quote_sub perlstring); use base qw(Class::Data::Inheritable); @@ -55,8 +55,10 @@ __PACKAGE__->mk_classdata('_transform_sql_handlers' => $self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" ) unless $rel_obj; my $join = $from_class->storage->sql_maker->_join_condition( - $from_class->result_source_instance->_resolve_condition( - $rel_obj->{cond}, $to, $from) ); + scalar $from_class->result_source_instance->_resolve_condition( + $rel_obj->{cond}, $to, $from + ) + ); return $join; } @@ -79,24 +81,20 @@ sub __driver { sub set_sql { my ($class, $name, $sql) = @_; - no strict 'refs'; - my $sql_name = "sql_${name}"; - my $full_sql_name = join '::', $class, $sql_name; - *$full_sql_name = Sub::Name::subname $full_sql_name, - sub { - my $sql = $sql; - my $class = shift; - return $class->storage->sth($class->transform_sql($sql, @_)); - }; - if ($sql =~ /select/i) { - my $search_name = "search_${name}"; - my $full_search_name = join '::', $class, $search_name; - *$full_search_name = Sub::Name::subname $full_search_name, - sub { - my ($class, @args) = @_; - my $sth = $class->$sql_name; - return $class->sth_to_objects($sth, \@args); - }; + + quote_sub "${class}::sql_${name}", sprintf( <<'EOC', perlstring $sql ); + my $class = shift; + return $class->storage->dbh_do( + _prepare_sth => $class->transform_sql(%s, @_) + ); +EOC + + + if ($sql =~ /select/i) { # FIXME - this should be anchore surely...? + quote_sub "${class}::search_${name}", sprintf( <<'EOC', "sql_$name" ); + my ($class, @args) = @_; + $class->sth_to_objects( $class->%s, \@args); +EOC } }