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; |
8d73fcd4 |
7 | use DBIx::Class::_Util qw(quote_sub perlstring); |
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 | |
35ca725a |
17 | __PACKAGE__->mk_classdata('_transform_sql_handlers' => {} ); |
dbd7896f |
18 | |
19 | sub db_Main { |
8b445e33 |
20 | return $_[0]->storage->dbh; |
dbd7896f |
21 | } |
22 | |
8b445e33 |
23 | sub connection { |
dbd7896f |
24 | my ($class, @info) = @_; |
25 | $info[3] = { %{ $info[3] || {}} }; |
26 | $info[3]->{RootClass} = 'DBIx::ContextualFetch'; |
147dd158 |
27 | return $class->next::method(@info); |
dbd7896f |
28 | } |
29 | |
30 | sub __driver { |
8b445e33 |
31 | return $_[0]->storage->dbh->{Driver}->{Name}; |
dbd7896f |
32 | } |
33 | |
a3018bd3 |
34 | sub set_sql { |
35 | my ($class, $name, $sql) = @_; |
8d73fcd4 |
36 | |
37 | quote_sub "${class}::sql_${name}", sprintf( <<'EOC', perlstring $sql ); |
38 | my $class = shift; |
39 | return $class->storage->dbh_do( |
40 | _prepare_sth => $class->transform_sql(%s, @_) |
41 | ); |
42 | EOC |
43 | |
44 | |
45 | if ($sql =~ /select/i) { # FIXME - this should be anchore surely...? |
46 | quote_sub "${class}::search_${name}", sprintf( <<'EOC', "sql_$name" ); |
47 | my ($class, @args) = @_; |
48 | $class->sth_to_objects( $class->%s, \@args); |
49 | EOC |
510ca912 |
50 | } |
51 | } |
52 | |
223b8fe3 |
53 | sub sth_to_objects { |
902133a3 |
54 | my ($class, $sth, $execute_args) = @_; |
55 | |
56 | $sth->execute(@$execute_args); |
57 | |
223b8fe3 |
58 | my @ret; |
b52e9bf8 |
59 | while (my $row = $sth->fetchrow_hashref) { |
8c49f629 |
60 | push(@ret, $class->inflate_result($class->result_source_instance, $row)); |
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; |