Remove Class::Data::Inheritable and use CAG 'inherited' style accessors
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / ImaDBI.pm
CommitLineData
c0e7b4e5 1package # hide from PAUSE
2 DBIx::Class::CDBICompat::ImaDBI;
dbd7896f 3
4use strict;
5use warnings;
aea8af71 6use DBIx::ContextualFetch;
8d73fcd4 7use DBIx::Class::_Util qw(quote_sub perlstring);
dbd7896f 8
5e0eea35 9use base 'DBIx::Class';
ef29a097 10
902133a3 11__PACKAGE__->mk_classdata('sql_transformer_class' =>
12 'DBIx::Class::CDBICompat::SQLTransformer');
13
dbd7896f 14sub db_Main {
8b445e33 15 return $_[0]->storage->dbh;
dbd7896f 16}
17
8b445e33 18sub 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
25sub __driver {
8b445e33 26 return $_[0]->storage->dbh->{Driver}->{Name};
dbd7896f 27}
28
a3018bd3 29sub 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 );
37EOC
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);
44EOC
510ca912 45 }
46}
47
223b8fe3 48sub 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 61sub 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 71package
72 DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS
aea8af71 73
74no warnings 'redefine';
75
76sub _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 891;