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