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