1 package # hide from PAUSE
2 DBIx::Class::CDBICompat::ImaDBI;
6 use DBIx::ContextualFetch;
8 use base qw/DBIx::Class/;
10 __PACKAGE__->mk_classdata('_transform_sql_handler_order'
11 => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] );
13 __PACKAGE__->mk_classdata('_transform_sql_handlers' =>
17 my ($self, $class, $data) = @_;
18 return $class->result_source_instance->name unless $data;
19 my ($f_class, $alias) = split(/=/, $data);
21 $self->{_classes}{$alias} = $f_class;
22 return $f_class->result_source_instance->name." ${alias}";
26 my ($self, $class, $data) = @_;
27 $class = $data ? $self->{_classes}{$data} : $class;
28 return join(', ', $class->columns('Essential'));
32 my ($self, $class, $data) = @_;
33 $class = $data ? $self->{_classes}{$data} : $class;
34 return join ' AND ', map "$_ = ?", $class->primary_columns;
38 my ($self, $class, $data) = @_;
39 my ($from, $to) = split(/ /, $data);
40 my ($from_class, $to_class) = @{$self->{_classes}}{$from, $to};
41 my ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class }
42 map { $from_class->relationship_info($_) }
43 $from_class->relationships;
45 ($from, $to) = ($to, $from);
46 ($from_class, $to_class) = ($to_class, $from_class);
47 ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class }
48 map { $from_class->relationship_info($_) }
49 $from_class->relationships;
51 $self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" )
53 my $join = $from_class->storage->sql_maker->_join_condition(
54 $from_class->result_source_instance->resolve_condition(
55 $rel_obj->{cond}, $to, $from) );
62 return $_[0]->storage->dbh;
66 my ($class, @info) = @_;
67 $info[3] = { %{ $info[3] || {}} };
68 $info[3]->{RootClass} = 'DBIx::ContextualFetch';
69 return $class->next::method(@info);
73 return $_[0]->storage->dbh->{Driver}->{Name};
77 my ($class, $name, $sql) = @_;
79 *{"${class}::sql_${name}"} =
83 return $class->storage->sth($class->transform_sql($sql, @_));
85 if ($sql =~ /select/i) {
86 my $meth = "sql_${name}";
87 *{"${class}::search_${name}"} =
89 my ($class, @args) = @_;
90 my $sth = $class->$meth;
92 return $class->sth_to_objects($sth);
98 my ($class, $sth) = @_;
100 while (my $row = $sth->fetchrow_hashref) {
101 push(@ret, $class->inflate_result($class->result_source_instance, $row));
107 my ($class, $sql, @args) = @_;
109 foreach my $key (@{$class->_transform_sql_handler_order}) {
110 my $h = $class->_transform_sql_handlers->{$key};
111 $sql =~ s/__$key(?:\(([^\)]+)\))?__/$h->($attrs, $class, $1)/eg;
114 return sprintf($sql, @args);
118 DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS
120 no warnings 'redefine';
122 sub _untaint_execute {
124 my $old_value = $sth->{Taint};
128 no warnings 'uninitialized';
129 $ret = $sth->SUPER::execute(@_);
131 $sth->{Taint} = $old_value;