initial sketch of Clauses.pm
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract / Clauses.pm
1 package SQL::Abstract::Clauses;
2
3 use strict;
4 use warnings;
5 use mro 'c3';
6 use base 'SQL::Abstract';
7
8 sub new {
9   shift->next::method(@_)->register_defaults
10 }
11
12 sub register_defaults {
13   my ($self) = @_;
14   $self->{clauses_of}{select} = [ qw(select from where order_by) ];
15   $self->{expand}{select} = sub { shift->_expand_statement(@_) };
16   $self->{render}{select} = sub { shift->_render_statement(@_) };
17   $self->{expand_clause}{'select.select'} = '_expand_maybe_list_expr';
18   $self->{expand_clause}{'select.from'} = sub {
19     $_[0]->_expand_maybe_list_expr($_[1], -ident)
20   };
21   $self->{expand_clause}{'select.where'} = 'expand_expr';
22   $self->{expand_clause}{'select.order_by'} = '_expand_order_by';
23   return $self;
24 }
25
26 sub _expand_statement {
27   my ($self, $type, $args) = @_;
28   my $ec = $self->{expand_clause};
29   return +{
30     map +($_ => (do {
31       my $val = $args->{$_};
32       if (defined($val) and my $exp = $ec->{"${type}.$_"}) {
33         $self->$exp($val);
34       } else {
35         $val;
36       }
37     })), sort keys %$args
38   };
39 }
40
41 sub _render_statement {
42   my ($self, $type, $args) = @_;
43   my @parts;
44   foreach my $clause (@{$self->{clauses_of}{$type}}) {
45     next unless my $clause_expr = $args->{$clause};
46     my ($sql, @bind) = $self->render_expr($clause_expr);
47     next unless defined($sql) and length($sql);
48     push @parts, [
49       $self->_sqlcase(join ' ', split '_', $clause).' '.$sql,
50       @bind
51     ];
52   }
53   return $self->_join_parts(' ', @parts);
54 }
55
56 1;