File Coverage

blib/lib/SQL/Abstract/Complete.pm
Criterion Covered Total %
statement 86 93 92.4
branch 59 80 73.7
condition 15 23 65.2
subroutine 10 10 100.0
pod 2 2 100.0
total 172 208 82.6


line stmt bran cond sub pod time code
1             package SQL::Abstract::Complete;
2             # ABSTRACT: Generate complete SQL from Perl data structures
3              
4 2     2   450741 use 5.010;
  2         9  
5 2     2   12 use strict;
  2         7  
  2         76  
6 2     2   12 use warnings;
  2         4  
  2         146  
7              
8 2     2   2260 use SQL::Abstract 1.5;
  2         61060  
  2         180  
9 2     2   654 use Storable 'dclone';
  2         4002  
  2         203  
10              
11 2     2   14 use vars '@ISA';
  2         4  
  2         3751  
12             @ISA = 'SQL::Abstract';
13              
14             our $VERSION = '1.11'; # VERSION
15              
16             sub new {
17 2     2 1 190086 my $self = shift;
18 2         41 $self = $self->SUPER::new(@_);
19 2   100     1561 $self->{'part_join'} ||= ' ';
20 2         32 return $self;
21             }
22              
23             sub _wipe_space {
24             return join( '', map {
25 61     61   358 s/\s{2,}/ /g;
  61         108  
26 61         214 s/^\s+|\s+$//g;
27 61         86 s/\s+,/,/g;
28 61         244 $_;
29             } @_ );
30             }
31              
32             sub _sqlcase {
33 69 100   69   3474 return ( $_[0]->{'case'} ) ? $_[1] : uc( ( defined( $_[1] ) ) ? $_[1] : '' );
    50          
34             }
35              
36             sub select {
37 16     16 1 5548 my ( $self, $tables, $columns, $where, $meta ) = @_;
38              
39 16   100     54 $columns //= '*';
40 16 100       39 $columns = [$columns] unless ( ref $columns );
41 16 50 33     35 $columns = ['*'] unless ( $columns and @{$columns} > 0 );
  16         46  
42              
43 16 100       288 $tables = dclone($tables) if ( ref $tables );
44              
45             my $columns_sql = $self->_sqlcase('select') . ' ' . _wipe_space(
46 0         0 ( ref($columns) eq 'SCALAR' ) ? ${$columns} :
47             ( not ref($columns) ) ? $self->_quote($columns) :
48             join( ', ', map {
49 1         4 ( ref($_) eq 'SCALAR' ) ? ${$_} :
50             ( not ref($_) ) ? $self->_quote($_) :
51 24 50       195 join( ' AS ', map { $self->_quote($_) } ( ref($_) eq 'HASH' ) ? %{$_} : @{$_} );
  2 100       20  
  1 100       3  
  0         0  
52 16 50       52 } @{$columns} )
  16 50       33  
53             );
54              
55 16         23 my $core_table;
56             my $tables_sql = join(
57             $self->{'part_join'},
58             map { _wipe_space( join( ' ',
59 23         42 $self->_sqlcase( shift( @{$_} ) ),
60 23         133 grep { defined } @{$_} )
  32         64  
  23         39  
61             ) } (
62 1         2 ( ref($tables) eq 'SCALAR' ) ? [ undef, ${$tables} ] :
63             ( not ref($tables) ) ? [ 'from', $self->_quote($tables) ] :
64             map {
65 2         5 ( ref($_) eq 'SCALAR' ) ? [ undef, ${$_} ] :
66             ( not ref($_) ) ? [ 'from', $self->_quote($_) ] :
67 12 100       20 do {
    100          
68 9 50       14 my @parts = ( ref($_) eq 'HASH' ) ? %{$_} : @{$_};
  0         0  
  9         15  
69 9 100       15 my $join_type = ( ref( $parts[0] ) eq 'SCALAR' ) ? ${ shift(@parts) } : 'join';
  2         17  
70              
71             my $join_on =
72 1         2 ( ref( $parts[-1] ) eq 'SCALAR' ) ? ${ pop(@parts) } :
73 9 100 66     33 ( ref( $parts[-1] ) eq 'HASH' and @parts > 1 ) ? do {
    100 66        
    100          
74 1         7 my $join_def = pop(@parts);
75 1 50       4 $join_type = $join_def->{'join'} . ' join' if ( $join_def->{'join'} );
76              
77             ( ref( $join_def->{'using'} || $join_def->{'on'} ) eq 'SCALAR' )
78 0 0       0 ? ${ $join_def->{'using'} || $join_def->{'on'} } :
79             ( $join_def->{'using'} )
80             ? $self->_sqlcase('using') . '(' . $join_def->{'using'} . ')' :
81             ( $join_def->{'on'} )
82 1 0 33     6 ? $self->_sqlcase('on') . ' ' . $join_def->{'on'} : '';
    50          
    50          
83             } :
84             ( not ref( $parts[-1] ) and @parts > 1 )
85             ? $self->_sqlcase('using') . '(' . $self->_quote( pop(@parts) ) . ')'
86             : '';
87              
88 9         47 my $table_def = shift(@parts);
89             $table_def =
90             ( not ref($table_def) ) ? $table_def :
91 0         0 ( ref($table_def) eq 'SCALAR' ) ? ${$table_def} :
92 9 50       17 do {
    50          
93 9 100       14 $table_def = [ %{$table_def} ] if ( ref($table_def) eq 'HASH' );
  4         7  
94 9         11 my $table_name = shift( @{$table_def} );
  9         32  
95              
96 9 100       14 unless ($core_table) {
97 3         3 $core_table = $table_name;
98 3         5 $join_type = 'from';
99             }
100              
101 9         108 $self->_quote($table_name) . ( ( @{$table_def} ) ? ' ' . join(
102             ' ',
103             $self->_sqlcase('as'),
104 9 50       12 map { $self->_quote($_) } @{$table_def},
  9         11  
  9         13  
105             ) : '' );
106             };
107              
108 9         102 [ $join_type, $table_def, $join_on ];
109             };
110 16 50       53 } ( ( ref($tables) ) ? @{$tables} : $tables )
  5 100       7  
    100          
111             )
112             );
113              
114 16         53 my ( $where_sql, @bind ) = $self->where($where);
115              
116 16   50     222 my ( $offset, $rows ) = ( $meta->{'offset'} || 0, $meta->{'rows'} || 0 );
      100        
117 16 50       30 if ( $meta->{'limit'} ) {
118             ( $offset, $rows ) = ( ref( $meta->{'limit'} ) eq 'ARRAY' )
119 0         0 ? @{ $meta->{'limit'} }
120 0 0       0 : ( 0, $meta->{'limit'} );
121             }
122 16 100       27 $offset = ( $meta->{'page'} - 1 ) * $rows if ( $meta->{'page'} );
123              
124             my $sql = join(
125             $self->{'part_join'},
126 112 100       201 grep { defined and $_ } (
127             $columns_sql,
128             $tables_sql,
129             _wipe_space($where_sql),
130             ( ( $meta->{'group_by'} ) ? do {
131             (
132 2         7 my $group_by = scalar( $self->_order_by( $meta->{'group_by'} ) )
133             ) =~ s/\s*ORDER BY/GROUP BY/;
134 2         23 _wipe_space($group_by);
135             } : undef ),
136             ( ( $meta->{'having'} ) ? do {
137 2         8 my ( $having, @having_bind ) = $self->where( $meta->{'having'} );
138 2         23 $having =~ s/\s*WHERE/HAVING/;
139 2 50       7 push( @bind, @having_bind ) if ( scalar(@having_bind) );
140 2         4 _wipe_space($having);
141             } : undef ),
142 16 100 66     38 ( ( $meta->{'order_by'} ) ? _wipe_space( $self->_order_by( $meta->{'order_by'} ) ) : undef ),
    100          
    100          
    100          
143             ( $offset or $rows )
144             ? $self->_sqlcase('limit') . " $rows " . $self->_sqlcase('offset') . " $offset"
145             : undef,
146             ),
147             );
148              
149 16         124 $sql =~ s/^\s+|\s+$//g;
150 16 100       100 return ( wantarray() ) ? ( $sql, @bind ) : $sql;
151             }
152              
153             1;
154              
155             __END__