lib/DBIx/Class/CDBICompat/SQLTransformer.pm

   1 package DBIx::Class::CDBICompat::SQLTransformer;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base 'DBIx::Class';
   7
   8 =head1 NAME
   9
  10 DBIx::Class::CDBICompat::SQLTransformer - Transform SQL
  11
  12 =head1 DESCRIPTION
  13
  14 This is a copy of L<Class::DBI::SQL::Transformer> from Class::DBI 3.0.17.
  15 It is here so we can be compatible with L<Class::DBI> without having it
  16 installed.
  17
  18 =cut
  19
  20 sub new {
  21     my ($me, $caller, $sql, @args) = @_;
  22     bless {
  23         _caller      => $caller,
  24         _sql         => $sql,
  25         _args        => [@args],
  26         _transformed => 0,
  27     } => $me;
  28 }
  29
  30 sub sql {
  31     my $self = shift;
  32     $self->_do_transformation if !$self->{_transformed};
  33     return $self->{_transformed_sql};
  34 }
  35
  36 sub args {
  37     my $self = shift;
  38     $self->_do_transformation if !$self->{_transformed};
  39     return @{ $self->{_transformed_args} };
  40 }
  41
  42 sub _expand_table {
  43     my $self = shift;
  44     my ($class, $alias) = split /=/, shift, 2;
  45     my $caller = $self->{_caller};
  46     my $table = $class ? $class->table : $caller->table;
  47     $self->{cmap}{ $alias || $table } = $class || ref $caller || $caller;
  48     ($alias ||= "") &&= " $alias";
  49     return $table . $alias;
  50 }
  51
  52 sub _expand_join {
  53     my $self  = shift;
  54     my $joins = shift;
  55     my @table = split /\s+/, $joins;
  56
  57     my $caller = $self->{_caller};
  58     my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1;
  59     my @sql;
  60     while (my ($t1, $t2) = each %tojoin) {
  61         my ($c1, $c2) = map $self->{cmap}{$_}
  62             || $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2);
  63
  64         my $join_col = sub {
  65             my ($c1, $c2) = @_;
  66             my $meta = $c1->meta_info('has_a');
  67             my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta;
  68             $col;
  69         };
  70
  71         my $col = $join_col->($c1 => $c2) || do {
  72             ($c1, $c2) = ($c2, $c1);
  73             ($t1, $t2) = ($t2, $t1);
  74             $join_col->($c1 => $c2);
  75         };
  76
  77         $caller->_croak("Don't know how to join $c1 to $c2") unless $col;
  78         push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2->primary_column;
  79     }
  80     return join " AND ", @sql;
  81 }
  82
  83 sub _do_transformation {
  84     my $me     = shift;
  85     my $sql    = $me->{_sql};
  86     my @args   = @{ $me->{_args} };
  87     my $caller = $me->{_caller};
  88
  89     $sql =~ s/__TABLE\(?(.*?)\)?__/$me->_expand_table($1)/eg;
  90     $sql =~ s/__JOIN\((.*?)\)__/$me->_expand_join($1)/eg;
  91     $sql =~ s/__ESSENTIAL__/join ", ", $caller->_essential/eg;
  92     $sql =~
  93         s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller->_essential/eg;
  94     if ($sql =~ /__IDENTIFIER__/) {
  95         my $key_sql = join " AND ", map "$_=?", $caller->primary_columns;
  96         $sql =~ s/__IDENTIFIER__/$key_sql/g;
  97     }
  98
  99     $me->{_transformed_sql}  = $sql;
 100     $me->{_transformed_args} = [@args];
 101     $me->{_transformed}      = 1;
 102     return 1;
 103 }
 104
 105 =head1 FURTHER QUESTIONS?
 106
 107 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 108
 109 =head1 COPYRIGHT AND LICENSE
 110
 111 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 112 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 113 redistribute it and/or modify it under the same terms as the
 114 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 115
 116 =cut
 117
 118 1;