File Coverage

blib/lib/SQL/Maker/SelectSet.pm
Criterion Covered Total %
statement 71 74 95.9
branch 9 16 56.2
condition 1 3 33.3
subroutine 17 17 100.0
pod 4 6 66.6
total 102 116 87.9


line stmt bran cond sub pod time code
1             package SQL::Maker::SelectSet;
2 1     1   5240 use strict;
  1         2  
  1         32  
3 1     1   4 use warnings;
  1         2  
  1         22  
4 1     1   4 use parent qw(Exporter);
  1         1  
  1         5  
5 1     1   42 use Scalar::Util ();
  1         1  
  1         9  
6 1     1   3 use Carp ();
  1         1  
  1         9  
7 1     1   3 use SQL::Maker::Util;
  1         2  
  1         23  
8             use Class::Accessor::Lite (
9 1         8 ro => [qw/new_line operator/],
10 1     1   3 );
  1         4  
11              
12             our @EXPORT_OK = qw(union union_all intersect intersect_all except except_all);
13              
14             # Functions
15             BEGIN {
16 1     1   2 for (qw/union union_all intersect intersect_all except except_all/) {
17 6         5 my $method = $_;
18 6         12 (my $operator = uc $_) =~ s/_/ /;
19              
20 1     1   131 no strict 'refs';
  1         4  
  1         115  
21 6         417 *{__PACKAGE__ . '::' . $method} = sub {
22 33     33   5144 my $stmt = SQL::Maker::SelectSet->new(
23             operator => $operator,
24             new_line => $_[0]->new_line,
25             );
26 30         68 $stmt->add_statement($_) for @_;
27 30         56 return $stmt;
28 6         15 };
29             }
30             }
31              
32             #
33             # Methods
34             #
35              
36             sub new {
37 30     30 1 178 my $class = shift;
38 30 50       86 my %args = @_==1 ? %{$_[0]} : @_;
  0         0  
39 30 50       63 Carp::croak("Missing mandatory parameter 'operator' for SQL::Maker::SelectSet->new") unless exists $args{operator};
40              
41 30         107 my $set = bless {
42             new_line => qq{\n},
43             %args,
44             }, $class;
45              
46 30         50 return $set;
47             }
48              
49             sub add_statement {
50 60     60 1 50 my ($self, $statement) = @_;
51              
52 60 50 33     314 unless ( Scalar::Util::blessed($statement) and $statement->can('as_sql') ) {
53 0         0 Carp::croak( "'$statement' doesn't have 'as_sql' method.");
54             }
55 60         46 push @{$self->{statements}}, $statement;
  60         121  
56 60         92 return $self; # method chain
57             }
58              
59             sub as_sql_order_by {
60 3     3 0 4 my ($self) = @_;
61              
62 3         3 my @attrs = @{$self->{order_by}};
  3         5  
63 3 50       7 return '' unless @attrs;
64              
65 3         5 return 'ORDER BY '
66             . join(', ', map {
67 3         5 my ($col, $type) = @$_;
68 3 50       5 if (ref $col) {
69 0         0 $$col
70             } else {
71 3 50       9 $type ? $self->_quote($col) . " $type" : $self->_quote($col)
72             }
73             } @attrs);
74             }
75              
76             sub _quote {
77 3     3   3 my ($self, $label) = @_;
78              
79 3 50       7 return $$label if ref $label eq 'SCALAR';
80 3         9 SQL::Maker::Util::quote_identifier($label, $self->{quote_char}, $self->{name_sep})
81             }
82              
83             sub as_sql {
84 36     36 1 88 my ($self) = @_;
85              
86 36         61 my $new_line = $self->new_line;
87 36         157 my $operator = $self->operator;
88              
89 72         123 my $sql = join(
90             $new_line . $operator . $new_line,
91 36         127 map { $_->as_sql } @{ $self->{statements} }
  36         51  
92             );
93 36 100       76 $sql .= ' ' . $self->as_sql_order_by() if $self->{order_by};
94 36         108 return $sql;
95             }
96              
97             sub bind {
98 36     36 1 53 my ($self) = @_;
99 36         26 my @binds;
100 36         29 for my $select ( @{ $self->{statements} } ) {
  36         61  
101 72         144 push @binds, $select->bind;
102             }
103 36         123 return @binds;
104             }
105              
106             sub add_order_by {
107 3     3 0 7 my ($self, $col, $type) = @_;
108 3         3 push @{$self->{order_by}}, [$col, $type];
  3         11  
109 3         4 return $self;
110             }
111              
112             1;
113             __END__