Commit | Line | Data |
902133a3 |
1 | package DBIx::Class::CDBICompat::SQLTransformer; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | =head1 NAME |
7 | |
8 | DBIx::Class::CDBICompat::SQLTransformer - Transform SQL |
9 | |
10 | =head1 DESCRIPTION |
11 | |
12 | This is a copy of L<Class::DBI::SQL::Transformer> from Class::DBI 3.0.17. |
13 | It is here so we can be compatible with L<Class::DBI> without having it |
14 | installed. |
15 | |
16 | =cut |
17 | |
18 | sub new { |
19 | my ($me, $caller, $sql, @args) = @_; |
20 | bless { |
21 | _caller => $caller, |
22 | _sql => $sql, |
23 | _args => [@args], |
24 | _transformed => 0, |
25 | } => $me; |
26 | } |
27 | |
28 | sub sql { |
29 | my $self = shift; |
30 | $self->_do_transformation if !$self->{_transformed}; |
31 | return $self->{_transformed_sql}; |
32 | } |
33 | |
34 | sub args { |
35 | my $self = shift; |
36 | $self->_do_transformation if !$self->{_transformed}; |
37 | return @{ $self->{_transformed_args} }; |
38 | } |
39 | |
40 | sub _expand_table { |
41 | my $self = shift; |
42 | my ($class, $alias) = split /=/, shift, 2; |
43 | my $caller = $self->{_caller}; |
44 | my $table = $class ? $class->table : $caller->table; |
45 | $self->{cmap}{ $alias || $table } = $class || ref $caller || $caller; |
46 | ($alias ||= "") &&= " $alias"; |
47 | return $table . $alias; |
48 | } |
49 | |
50 | sub _expand_join { |
51 | my $self = shift; |
52 | my $joins = shift; |
53 | my @table = split /\s+/, $joins; |
54 | |
55 | my $caller = $self->{_caller}; |
56 | my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1; |
57 | my @sql; |
58 | while (my ($t1, $t2) = each %tojoin) { |
59 | my ($c1, $c2) = map $self->{cmap}{$_} |
60 | || $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2); |
61 | |
62 | my $join_col = sub { |
63 | my ($c1, $c2) = @_; |
64 | my $meta = $c1->meta_info('has_a'); |
65 | my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta; |
66 | $col; |
67 | }; |
68 | |
69 | my $col = $join_col->($c1 => $c2) || do { |
70 | ($c1, $c2) = ($c2, $c1); |
71 | ($t1, $t2) = ($t2, $t1); |
72 | $join_col->($c1 => $c2); |
73 | }; |
74 | |
75 | $caller->_croak("Don't know how to join $c1 to $c2") unless $col; |
76 | push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2->primary_column; |
77 | } |
78 | return join " AND ", @sql; |
79 | } |
80 | |
81 | sub _do_transformation { |
82 | my $me = shift; |
83 | my $sql = $me->{_sql}; |
84 | my @args = @{ $me->{_args} }; |
85 | my $caller = $me->{_caller}; |
86 | |
87 | $sql =~ s/__TABLE\(?(.*?)\)?__/$me->_expand_table($1)/eg; |
88 | $sql =~ s/__JOIN\((.*?)\)__/$me->_expand_join($1)/eg; |
89 | $sql =~ s/__ESSENTIAL__/join ", ", $caller->_essential/eg; |
90 | $sql =~ |
91 | s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller->_essential/eg; |
92 | if ($sql =~ /__IDENTIFIER__/) { |
93 | my $key_sql = join " AND ", map "$_=?", $caller->primary_columns; |
94 | $sql =~ s/__IDENTIFIER__/$key_sql/g; |
95 | } |
96 | |
97 | $me->{_transformed_sql} = $sql; |
98 | $me->{_transformed_args} = [@args]; |
99 | $me->{_transformed} = 1; |
100 | return 1; |
101 | } |
102 | |
103 | 1; |
104 | |