X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FImaDBI.pm;h=85aced21e04f509e0976b01709a8c2cf817cb2d4;hb=9f30030205481d5b2c8d0f7d637259c5ae6dd52d;hp=0a143fa8fcd836c6cf6244890d1fbacb5c0a3f37;hpb=e60dc79fcd4d6318e83584b826526e65048b86a9;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm index 0a143fa..85aced2 100644 --- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm +++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm @@ -4,8 +4,12 @@ package # hide from PAUSE use strict; use warnings; use DBIx::ContextualFetch; +use Sub::Name (); -use base qw/DBIx::Class/; +use base qw(Class::Data::Inheritable); + +__PACKAGE__->mk_classdata('sql_transformer_class' => + 'DBIx::Class::CDBICompat::SQLTransformer'); __PACKAGE__->mk_classdata('_transform_sql_handler_order' => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] ); @@ -51,11 +55,13 @@ __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; } - + } ); sub db_Main { @@ -76,42 +82,47 @@ sub __driver { sub set_sql { my ($class, $name, $sql) = @_; no strict 'refs'; - *{"${class}::sql_${name}"} = + 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, @_)); + return $class->storage->_sth($class->transform_sql($sql, @_)); }; if ($sql =~ /select/i) { - my $meth = "sql_${name}"; - *{"${class}::search_${name}"} = + 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->$meth; - $sth->execute(@args); - return $class->sth_to_objects($sth); + my $sth = $class->$sql_name; + return $class->sth_to_objects($sth, \@args); }; } } sub sth_to_objects { - my ($class, $sth) = @_; + my ($class, $sth, $execute_args) = @_; + + $sth->execute(@$execute_args); + my @ret; while (my $row = $sth->fetchrow_hashref) { push(@ret, $class->inflate_result($class->result_source_instance, $row)); } + return @ret; } sub transform_sql { my ($class, $sql, @args) = @_; - my $attrs = { }; - foreach my $key (@{$class->_transform_sql_handler_order}) { - my $h = $class->_transform_sql_handlers->{$key}; - $sql =~ s/__$key(?:\(([^\)]+)\))?__/$h->($attrs, $class, $1)/eg; - } - #warn $sql; - return sprintf($sql, @args); + + my $tclass = $class->sql_transformer_class; + $class->ensure_class_loaded($tclass); + my $t = $tclass->new($class, $sql, @args); + + return sprintf($t->sql, $t->args); } package