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 1;
 104