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 | |
5e0eea35 |
8 | use base 'DBIx::Class'; |
ef29a097 |
9 | |
51ec0382 |
10 | use DBIx::Class::_Util qw(quote_sub perlstring); |
11 | use namespace::clean; |
12 | |
902133a3 |
13 | __PACKAGE__->mk_classdata('sql_transformer_class' => |
14 | 'DBIx::Class::CDBICompat::SQLTransformer'); |
15 | |
dbd7896f |
16 | sub db_Main { |
8b445e33 |
17 | return $_[0]->storage->dbh; |
dbd7896f |
18 | } |
19 | |
8b445e33 |
20 | sub connection { |
dbd7896f |
21 | my ($class, @info) = @_; |
22 | $info[3] = { %{ $info[3] || {}} }; |
23 | $info[3]->{RootClass} = 'DBIx::ContextualFetch'; |
147dd158 |
24 | return $class->next::method(@info); |
dbd7896f |
25 | } |
26 | |
27 | sub __driver { |
8b445e33 |
28 | return $_[0]->storage->dbh->{Driver}->{Name}; |
dbd7896f |
29 | } |
30 | |
a3018bd3 |
31 | sub set_sql { |
32 | my ($class, $name, $sql) = @_; |
8d73fcd4 |
33 | |
34 | quote_sub "${class}::sql_${name}", sprintf( <<'EOC', perlstring $sql ); |
35 | my $class = shift; |
36 | return $class->storage->dbh_do( |
37 | _prepare_sth => $class->transform_sql(%s, @_) |
38 | ); |
39 | EOC |
40 | |
41 | |
42 | if ($sql =~ /select/i) { # FIXME - this should be anchore surely...? |
43 | quote_sub "${class}::search_${name}", sprintf( <<'EOC', "sql_$name" ); |
44 | my ($class, @args) = @_; |
45 | $class->sth_to_objects( $class->%s, \@args); |
46 | EOC |
510ca912 |
47 | } |
48 | } |
49 | |
223b8fe3 |
50 | sub sth_to_objects { |
902133a3 |
51 | my ($class, $sth, $execute_args) = @_; |
52 | |
53 | $sth->execute(@$execute_args); |
54 | |
e570488a |
55 | my (@ret, $rsrc); |
b52e9bf8 |
56 | while (my $row = $sth->fetchrow_hashref) { |
e570488a |
57 | push(@ret, $class->inflate_result( |
58 | ( $rsrc ||= $class->result_source ), |
59 | $row |
60 | )); |
223b8fe3 |
61 | } |
902133a3 |
62 | |
223b8fe3 |
63 | return @ret; |
64 | } |
65 | |
510ca912 |
66 | sub transform_sql { |
67 | my ($class, $sql, @args) = @_; |
d4daee7b |
68 | |
902133a3 |
69 | my $tclass = $class->sql_transformer_class; |
70 | $class->ensure_class_loaded($tclass); |
71 | my $t = $tclass->new($class, $sql, @args); |
72 | |
73 | return sprintf($t->sql, $t->args); |
a3018bd3 |
74 | } |
75 | |
a2800991 |
76 | package |
77 | DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS |
aea8af71 |
78 | |
79 | no warnings 'redefine'; |
80 | |
81 | sub _untaint_execute { |
82 | my $sth = shift; |
83 | my $old_value = $sth->{Taint}; |
84 | $sth->{Taint} = 0; |
85 | my $ret; |
86 | { |
87 | no warnings 'uninitialized'; |
88 | $ret = $sth->SUPER::execute(@_); |
89 | } |
90 | $sth->{Taint} = $old_value; |
91 | return $ret; |
92 | } |
93 | |
dbd7896f |
94 | 1; |