X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FImaDBI.pm;h=49fc1e01c2a930543a9668d6b56ee5f6eea8f456;hb=d4daee7b54e38e4b3d3d0a77759bddc1a4ede6e5;hp=3a172812cc9e1159e3f36bfe37a103e9f1a2da20;hpb=147dd158cf91465b8a48adce738d56b85f7d1b9b;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm index 3a17281..49fc1e0 100644 --- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm +++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm @@ -1,31 +1,41 @@ -package DBIx::Class::CDBICompat::ImaDBI; +package # hide from PAUSE + DBIx::Class::CDBICompat::ImaDBI; use strict; use warnings; use DBIx::ContextualFetch; +use Sub::Name (); -use NEXT; -use base qw/Class::Data::Inheritable/; +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/ ] ); + => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] ); __PACKAGE__->mk_classdata('_transform_sql_handlers' => { 'TABLE' => sub { my ($self, $class, $data) = @_; - return $class->_table_name unless $data; + return $class->result_source_instance->name unless $data; my ($f_class, $alias) = split(/=/, $data); $f_class ||= $class; $self->{_classes}{$alias} = $f_class; - return $f_class->_table_name." ${alias}"; + return $f_class->result_source_instance->name." ${alias}"; }, 'ESSENTIAL' => sub { my ($self, $class, $data) = @_; - return join(' ', $class->columns('Essential')) unless $data; - return join(' ', $self->{_classes}{$data}->columns('Essential')); + $class = $data ? $self->{_classes}{$data} : $class; + return join(', ', $class->columns('Essential')); + }, + 'IDENTIFIER' => + sub { + my ($self, $class, $data) = @_; + $class = $data ? $self->{_classes}{$data} : $class; + return join ' AND ', map "$_ = ?", $class->primary_columns; }, 'JOIN' => sub { @@ -33,25 +43,23 @@ __PACKAGE__->mk_classdata('_transform_sql_handlers' => my ($from, $to) = split(/ /, $data); my ($from_class, $to_class) = @{$self->{_classes}}{$from, $to}; my ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class } - values %{ $from_class->_relationships }; + map { $from_class->relationship_info($_) } + $from_class->relationships; unless ($rel_obj) { ($from, $to) = ($to, $from); ($from_class, $to_class) = ($to_class, $from_class); ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class } - values %{ $from_class->_relationships }; + map { $from_class->relationship_info($_) } + $from_class->relationships; } - $self->throw( "No relationship to JOIN from ${from_class} to ${to_class}" ) + $self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" ) unless $rel_obj; - my $attrs = { - %$self, - _aliases => { self => $from, foreign => $to }, - _action => 'join', - }; my $join = $from_class->storage->sql_maker->_join_condition( - $from_class->resolve_condition($rel_obj->{cond}, $attrs) ); + $from_class->result_source_instance->_resolve_condition( + $rel_obj->{cond}, $to, $from) ); return $join; } - + } ); sub db_Main { @@ -71,50 +79,52 @@ sub __driver { sub set_sql { my ($class, $name, $sql) = @_; - my $table = $class->_table_name; - #$sql =~ s/__TABLE__/$table/; 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, @_)); }; 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 @cols = $class->_select_columns; + my ($class, $sth, $execute_args) = @_; + + $sth->execute(@$execute_args); + my @ret; - while (my @row = $sth->fetchrow_array) { - push(@ret, $class->_row_to_object(\@cols,\@row)); + 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 $table = $class->_table_name; - 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 DBIx::ContextualFetch::st; +package + DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS no warnings 'redefine';