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