Commit | Line | Data |
c0e7b4e5 |
1 | package # hide from PAUSE |
2 | DBIx::Class::CDBICompat::ImaDBI; |
dbd7896f |
3 | |
4 | use strict; |
5 | use warnings; |
aea8af71 |
6 | use DBIx::ContextualFetch; |
ddc0a6c8 |
7 | use Sub::Name (); |
dbd7896f |
8 | |
5e85c671 |
9 | use base qw(Class::Data::Inheritable); |
ef29a097 |
10 | |
902133a3 |
11 | __PACKAGE__->mk_classdata('sql_transformer_class' => |
12 | 'DBIx::Class::CDBICompat::SQLTransformer'); |
13 | |
12bbb339 |
14 | __PACKAGE__->mk_classdata('_transform_sql_handler_order' |
e60dc79f |
15 | => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] ); |
12bbb339 |
16 | |
ef29a097 |
17 | __PACKAGE__->mk_classdata('_transform_sql_handlers' => |
18 | { |
12bbb339 |
19 | 'TABLE' => |
20 | sub { |
21 | my ($self, $class, $data) = @_; |
b98e75f6 |
22 | return $class->result_source_instance->name unless $data; |
12bbb339 |
23 | my ($f_class, $alias) = split(/=/, $data); |
24 | $f_class ||= $class; |
d2ff6175 |
25 | $self->{_classes}{$alias} = $f_class; |
b98e75f6 |
26 | return $f_class->result_source_instance->name." ${alias}"; |
12bbb339 |
27 | }, |
28 | 'ESSENTIAL' => |
29 | sub { |
30 | my ($self, $class, $data) = @_; |
e60dc79f |
31 | $class = $data ? $self->{_classes}{$data} : $class; |
32 | return join(', ', $class->columns('Essential')); |
33 | }, |
34 | 'IDENTIFIER' => |
35 | sub { |
36 | my ($self, $class, $data) = @_; |
37 | $class = $data ? $self->{_classes}{$data} : $class; |
38 | return join ' AND ', map "$_ = ?", $class->primary_columns; |
12bbb339 |
39 | }, |
40 | 'JOIN' => |
41 | sub { |
42 | my ($self, $class, $data) = @_; |
43 | my ($from, $to) = split(/ /, $data); |
d2ff6175 |
44 | my ($from_class, $to_class) = @{$self->{_classes}}{$from, $to}; |
12bbb339 |
45 | my ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class } |
4685e006 |
46 | map { $from_class->relationship_info($_) } |
47 | $from_class->relationships; |
12bbb339 |
48 | unless ($rel_obj) { |
49 | ($from, $to) = ($to, $from); |
50 | ($from_class, $to_class) = ($to_class, $from_class); |
51 | ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class } |
4685e006 |
52 | map { $from_class->relationship_info($_) } |
53 | $from_class->relationships; |
12bbb339 |
54 | } |
701da8c4 |
55 | $self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" ) |
12bbb339 |
56 | unless $rel_obj; |
fef5d100 |
57 | my $join = $from_class->storage->sql_maker->_join_condition( |
1327f050 |
58 | scalar $from_class->result_source_instance->_resolve_condition( |
59 | $rel_obj->{cond}, $to, $from |
60 | ) |
61 | ); |
12bbb339 |
62 | return $join; |
63 | } |
d4daee7b |
64 | |
ef29a097 |
65 | } ); |
dbd7896f |
66 | |
67 | sub db_Main { |
8b445e33 |
68 | return $_[0]->storage->dbh; |
dbd7896f |
69 | } |
70 | |
8b445e33 |
71 | sub connection { |
dbd7896f |
72 | my ($class, @info) = @_; |
73 | $info[3] = { %{ $info[3] || {}} }; |
74 | $info[3]->{RootClass} = 'DBIx::ContextualFetch'; |
147dd158 |
75 | return $class->next::method(@info); |
dbd7896f |
76 | } |
77 | |
78 | sub __driver { |
8b445e33 |
79 | return $_[0]->storage->dbh->{Driver}->{Name}; |
dbd7896f |
80 | } |
81 | |
a3018bd3 |
82 | sub set_sql { |
83 | my ($class, $name, $sql) = @_; |
a3018bd3 |
84 | no strict 'refs'; |
ddc0a6c8 |
85 | my $sql_name = "sql_${name}"; |
86 | my $full_sql_name = join '::', $class, $sql_name; |
87 | *$full_sql_name = Sub::Name::subname $full_sql_name, |
a3018bd3 |
88 | sub { |
89 | my $sql = $sql; |
90 | my $class = shift; |
402ac1c9 |
91 | return $class->storage->_sth($class->transform_sql($sql, @_)); |
a3018bd3 |
92 | }; |
510ca912 |
93 | if ($sql =~ /select/i) { |
ddc0a6c8 |
94 | my $search_name = "search_${name}"; |
95 | my $full_search_name = join '::', $class, $search_name; |
96 | *$full_search_name = Sub::Name::subname $full_search_name, |
510ca912 |
97 | sub { |
98 | my ($class, @args) = @_; |
ddc0a6c8 |
99 | my $sth = $class->$sql_name; |
902133a3 |
100 | return $class->sth_to_objects($sth, \@args); |
510ca912 |
101 | }; |
102 | } |
103 | } |
104 | |
223b8fe3 |
105 | sub sth_to_objects { |
902133a3 |
106 | my ($class, $sth, $execute_args) = @_; |
107 | |
108 | $sth->execute(@$execute_args); |
109 | |
223b8fe3 |
110 | my @ret; |
b52e9bf8 |
111 | while (my $row = $sth->fetchrow_hashref) { |
8c49f629 |
112 | push(@ret, $class->inflate_result($class->result_source_instance, $row)); |
223b8fe3 |
113 | } |
902133a3 |
114 | |
223b8fe3 |
115 | return @ret; |
116 | } |
117 | |
510ca912 |
118 | sub transform_sql { |
119 | my ($class, $sql, @args) = @_; |
d4daee7b |
120 | |
902133a3 |
121 | my $tclass = $class->sql_transformer_class; |
122 | $class->ensure_class_loaded($tclass); |
123 | my $t = $tclass->new($class, $sql, @args); |
124 | |
125 | return sprintf($t->sql, $t->args); |
a3018bd3 |
126 | } |
127 | |
a2800991 |
128 | package |
129 | DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS |
aea8af71 |
130 | |
131 | no warnings 'redefine'; |
132 | |
133 | sub _untaint_execute { |
134 | my $sth = shift; |
135 | my $old_value = $sth->{Taint}; |
136 | $sth->{Taint} = 0; |
137 | my $ret; |
138 | { |
139 | no warnings 'uninitialized'; |
140 | $ret = $sth->SUPER::execute(@_); |
141 | } |
142 | $sth->{Taint} = $old_value; |
143 | return $ret; |
144 | } |
145 | |
dbd7896f |
146 | 1; |