1package DBIx::Class::CDBICompat::SQLTransformer;
2
3use strict;
4use warnings;
5
6=head1 NAME
7
8DBIx::Class::CDBICompat::SQLTransformer - Transform SQL
9
10=head1 DESCRIPTION
11
12This is a copy of L<Class::DBI::SQL::Transformer> from Class::DBI 3.0.17.
13It is here so we can be compatible with L<Class::DBI> without having it
14installed.
15
16=cut
17
18sub 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
28sub sql {
29    my $self = shift;
30    $self->_do_transformation if !$self->{_transformed};
31    return $self->{_transformed_sql};
32}
33
34sub args {
35    my $self = shift;
36    $self->_do_transformation if !$self->{_transformed};
37    return @{ $self->{_transformed_args} };
38}
39
40sub _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
50sub _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
81sub _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
1031;
104
105