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