Remove last remaining accesses to ->VERSION in lib
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / SQLTransformer.pm
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 =head1 FURTHER QUESTIONS?
104
105 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
106
107 =head1 COPYRIGHT AND LICENSE
108
109 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
110 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
111 redistribute it and/or modify it under the same terms as the
112 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
113
114 =cut
115
116 1;