X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FImaDBI.pm;h=0a143fa8fcd836c6cf6244890d1fbacb5c0a3f37;hb=1097f5e4f0e0a5fc2c30851cb9a0141712a85fcf;hp=9a451a22a40dab8694abb195d51f9ef5e6f75ad2;hpb=d2ff61755ca68931ee219adac1572b58f2abb3f2;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm index 9a451a2..0a143fa 100644 --- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm +++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm @@ -1,30 +1,37 @@ -package DBIx::Class::CDBICompat::ImaDBI; +package # hide from PAUSE + DBIx::Class::CDBICompat::ImaDBI; use strict; use warnings; +use DBIx::ContextualFetch; -use NEXT; -use base qw/Class::Data::Inheritable/; +use base qw/DBIx::Class/; __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 { @@ -32,71 +39,97 @@ __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->_cond_resolve($rel_obj->{cond}, $attrs); + my $join = $from_class->storage->sql_maker->_join_condition( + $from_class->result_source_instance->resolve_condition( + $rel_obj->{cond}, $to, $from) ); return $join; } } ); sub db_Main { - return $_[0]->_get_dbh; + return $_[0]->storage->dbh; } -sub _dbi_connect { +sub connection { my ($class, @info) = @_; $info[3] = { %{ $info[3] || {}} }; $info[3]->{RootClass} = 'DBIx::ContextualFetch'; - return $class->NEXT::_dbi_connect(@info); + return $class->next::method(@info); } sub __driver { - return $_[0]->_get_dbh->{Driver}->{Name}; + return $_[0]->storage->dbh->{Driver}->{Name}; } sub set_sql { my ($class, $name, $sql) = @_; - my $table = $class->_table_name; - #$sql =~ s/__TABLE__/$table/; no strict 'refs'; *{"${class}::sql_${name}"} = sub { my $sql = $sql; my $class = shift; - return $class->_sql_to_sth($class->transform_sql($sql, @_)); + return $class->storage->sth($class->transform_sql($sql, @_)); }; if ($sql =~ /select/i) { my $meth = "sql_${name}"; *{"${class}::search_${name}"} = sub { my ($class, @args) = @_; - $class->sth_to_objects($class->$meth, \@args); + my $sth = $class->$meth; + $sth->execute(@args); + return $class->sth_to_objects($sth); }; } } +sub sth_to_objects { + my ($class, $sth) = @_; + 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 $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); } +package + DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS + +no warnings 'redefine'; + +sub _untaint_execute { + my $sth = shift; + my $old_value = $sth->{Taint}; + $sth->{Taint} = 0; + my $ret; + { + no warnings 'uninitialized'; + $ret = $sth->SUPER::execute(@_); + } + $sth->{Taint} = $old_value; + return $ret; +} + 1;