1package Class::DBI::SQL::Transformer; 2 3use strict; 4use warnings; 5 6=head1 NAME 7 8Class::DBI::SQL::Transformer - Transform SQL 9 10=head1 SYNOPSIS 11 12 my $trans = $tclass->new($self, $sql, @args); 13 return $self->SUPER::transform_sql($trans->sql => $trans->args); 14 15=head1 DESCRIPTION 16 17Class::DBI hooks into the transform_sql() method in Ima::DBI to provide 18its own SQL extensions. Class::DBI::SQL::Transformer does the heavy 19lifting of these transformations. 20 21=head1 CONSTRUCTOR 22 23=head2 new 24 25 my $trans = $tclass->new($self, $sql, @args); 26 27Create a new transformer for the SQL and arguments that will be used 28with the given object (or class). 29 30=cut 31 32sub new { 33 my ($me, $caller, $sql, @args) = @_; 34 bless { 35 _caller => $caller, 36 _sql => $sql, 37 _args => [@args], 38 _transformed => 0, 39 } => $me; 40} 41 42=head2 sql / args 43 44 my $sql = $trans->sql; 45 my @args = $trans->args; 46 47The transformed SQL and args. 48 49=cut 50 51# TODO Document what the different transformations are 52# and factor out how they're called so that people can pick and mix the 53# ones they want and add new ones. 54 55sub sql { 56 my $self = shift; 57 $self->_do_transformation if !$self->{_transformed}; 58 return $self->{_transformed_sql}; 59} 60 61sub args { 62 my $self = shift; 63 $self->_do_transformation if !$self->{_transformed}; 64 return @{ $self->{_transformed_args} }; 65} 66 67sub _expand_table { 68 my $self = shift; 69 my ($class, $alias) = split /=/, shift, 2; 70 my $caller = $self->{_caller}; 71 my $table = $class ? $class->table : $caller->table; 72 $self->{cmap}{ $alias || $table } = $class || ref $caller || $caller; 73 ($alias ||= "") &&= " $alias"; 74 return $table . $alias; 75} 76 77sub _expand_join { 78 my $self = shift; 79 my $joins = shift; 80 my @table = split /\s+/, $joins; 81 82 my $caller = $self->{_caller}; 83 my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1; 84 my @sql; 85 while (my ($t1, $t2) = each %tojoin) { 86 my ($c1, $c2) = map $self->{cmap}{$_} 87 || $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2); 88 89 my $join_col = sub { 90 my ($c1, $c2) = @_; 91 my $meta = $c1->meta_info('has_a'); 92 my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta; 93 $col; 94 }; 95 96 my $col = $join_col->($c1 => $c2) || do { 97 ($c1, $c2) = ($c2, $c1); 98 ($t1, $t2) = ($t2, $t1); 99 $join_col->($c1 => $c2); 100 }; 101 102 $caller->_croak("Don't know how to join $c1 to $c2") unless $col; 103 push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2->primary_column; 104 } 105 return join " AND ", @sql; 106} 107 108sub _do_transformation { 109 my $me = shift; 110 my $sql = $me->{_sql}; 111 my @args = @{ $me->{_args} }; 112 my $caller = $me->{_caller}; 113 114 $sql =~ s/__TABLE\(?(.*?)\)?__/$me->_expand_table($1)/eg; 115 $sql =~ s/__JOIN\((.*?)\)__/$me->_expand_join($1)/eg; 116 $sql =~ s/__ESSENTIAL__/join ", ", $caller->_essential/eg; 117 $sql =~ 118 s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller->_essential/eg; 119 if ($sql =~ /__IDENTIFIER__/) { 120 my $key_sql = join " AND ", map "$_=?", $caller->primary_columns; 121 $sql =~ s/__IDENTIFIER__/$key_sql/g; 122 } 123 124 $me->{_transformed_sql} = $sql; 125 $me->{_transformed_args} = [@args]; 126 $me->{_transformed} = 1; 127 return 1; 128} 129 1301; 131 132