Commit | Line | Data |
dbd7896f |
1 | package DBIx::Class::CDBICompat::ImaDBI; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use NEXT; |
ef29a097 |
7 | use base qw/Class::Data::Inheritable/; |
8 | |
9 | __PACKAGE__->mk_classdata('_transform_sql_handlers' => |
10 | { |
11 | 'TABLE' => sub { return $_[0]->_table_name }, |
12 | 'ESSENTIAL' => sub { join(' ', $_[0]->columns('Essential')) }, |
13 | } ); |
dbd7896f |
14 | |
15 | sub db_Main { |
16 | return $_[0]->_get_dbh; |
17 | } |
18 | |
19 | sub _dbi_connect { |
20 | my ($class, @info) = @_; |
21 | $info[3] = { %{ $info[3] || {}} }; |
22 | $info[3]->{RootClass} = 'DBIx::ContextualFetch'; |
23 | return $class->NEXT::_dbi_connect(@info); |
24 | } |
25 | |
26 | sub __driver { |
27 | return $_[0]->_get_dbh->{Driver}->{Name}; |
28 | } |
29 | |
a3018bd3 |
30 | sub set_sql { |
31 | my ($class, $name, $sql) = @_; |
32 | my $table = $class->_table_name; |
33 | #$sql =~ s/__TABLE__/$table/; |
34 | no strict 'refs'; |
35 | *{"${class}::sql_${name}"} = |
36 | sub { |
37 | my $sql = $sql; |
38 | my $class = shift; |
510ca912 |
39 | return $class->_sql_to_sth($class->transform_sql($sql, @_)); |
a3018bd3 |
40 | }; |
510ca912 |
41 | if ($sql =~ /select/i) { |
42 | my $meth = "sql_${name}"; |
43 | *{"${class}::search_${name}"} = |
44 | sub { |
45 | my ($class, @args) = @_; |
46 | $class->sth_to_objects($class->$meth, \@args); |
47 | }; |
48 | } |
49 | } |
50 | |
51 | sub transform_sql { |
52 | my ($class, $sql, @args) = @_; |
53 | my $table = $class->_table_name; |
ef29a097 |
54 | foreach my $key (keys %{ $class->_transform_sql_handlers }) { |
55 | my $h = $class->_transform_sql_handlers->{$key}; |
56 | $sql =~ s/__$key(?:\(([^\)]+)\))?__/$h->($class, $1)/eg; |
57 | } |
510ca912 |
58 | return sprintf($sql, @args); |
a3018bd3 |
59 | } |
60 | |
dbd7896f |
61 | 1; |