Merge branch 'master' into dq
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm
index a8e4a57..8f1fe83 100644 (file)
@@ -5,10 +5,12 @@ use List::Util ();
 use Scalar::Util ();
 use Module::Runtime qw(use_module);
 use Moo;
+use namespace::clean;
 
-our $VERSION  = '1.72';
+our $VERSION  = '1.77';
 
-$VERSION = eval $VERSION;
+# This would confuse some packagers
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 sub belch (@) {
   my($func) = (caller(1))[3];
@@ -75,6 +77,11 @@ has quote_char => (
   },
 );
 
+has collapse_aliases => (
+  is => 'ro',
+  default => sub { 0 }
+);
+
 has always_quote => (
   is => 'rw', default => sub { 1 },
   trigger => sub {
@@ -88,13 +95,36 @@ has convert => (is => 'ro');
 has array_datatypes => (is => 'ro');
 
 has converter_class => (
-  is => 'ro', default => sub { 'SQL::Abstract::Converter' }
+  is => 'rw', lazy => 1, builder => '_build_converter_class',
+  trigger => sub { shift->clear_converter },
 );
 
+sub _build_converter_class {
+  use_module('SQL::Abstract::Converter')
+}
+
 has renderer_class => (
-  is => 'ro', default => sub { 'Data::Query::Renderer::SQL::Naive' }
+  is => 'rw', lazy => 1, clearer => 1, builder => 1,
+  trigger => sub { shift->clear_renderer },
 );
 
+after clear_renderer_class => sub { shift->clear_renderer };
+
+sub _build_renderer_class {
+  my ($self) = @_;
+  my ($class, @roles) = (
+    $self->_build_base_renderer_class, $self->_build_renderer_roles
+  );
+  return $class unless @roles;
+  return use_module('Moo::Role')->create_class_with_roles($class, @roles);
+}
+
+sub _build_base_renderer_class {
+  use_module('Data::Query::Renderer::SQL::Naive')
+}
+
+sub _build_renderer_roles { () }
+
 sub _converter_args {
   my ($self) = @_;
   Scalar::Util::weaken($self);
@@ -123,7 +153,7 @@ sub _converter_args {
 
 sub _build_converter {
   my ($self) = @_;
-  use_module($self->converter_class)->new($self->_converter_args);
+  $self->converter_class->new($self->_converter_args);
 }
 
 sub _renderer_args {
@@ -135,13 +165,14 @@ sub _renderer_args {
   +{
     quote_chars => $chars, always_quote => $self->always_quote,
     identifier_sep => $self->name_sep,
+    collapse_aliases => $self->collapse_aliases,
     ($self->case ? (lc_keywords => 1) : ()), # always 'lower' if it exists
   };
 }
 
 sub _build_renderer {
   my ($self) = @_;
-  use_module($self->renderer_class)->new($self->_renderer_args);
+  $self->renderer_class->new($self->_renderer_args);
 }
 
 sub _render_dq {
@@ -237,27 +268,15 @@ sub _quote {
 sub _assert_pass_injection_guard {
   if ($_[1] =~ $_[0]->{injection_guard}) {
     my $class = ref $_[0];
-    die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the
- "
-     . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own 
-"
-     . "{injection_guard} attribute to ${class}->new()"
+    die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of "
+      . "the desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply "
+      . "your own {injection_guard} attribute to ${class}->new()"
   }
 }
 
 # Conversion, if applicable
 sub _convert ($) {
   #my ($self, $arg) = @_;
-
-# LDNOTE : modified the previous implementation below because
-# it was not consistent : the first "return" is always an array,
-# the second "return" is context-dependent. Anyway, _convert
-# seems always used with just a single argument, so make it a
-# scalar function.
-#     return @_ unless $self->{convert};
-#     my $conv = $self->_sqlcase($self->{convert});
-#     my @ret = map { $conv.'('.$_.')' } @_;
-#     return wantarray ? @ret : $ret[0];
   if ($_[0]->{convert}) {
     return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
   }
@@ -267,11 +286,6 @@ sub _convert ($) {
 # And bindtype
 sub _bindtype (@) {
   #my ($self, $col, @vals) = @_;
-
-  #LDNOTE : changed original implementation below because it did not make
-  # sense when bindtype eq 'columns' and @vals > 1.
-#  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
-
   # called often - tighten code
   return $_[0]->{bindtype} eq 'columns'
     ? map {[$_[1], $_]} @_[2 .. $#_]
@@ -402,7 +416,7 @@ SQL::Abstract - Generate SQL from Perl data structures
 
     my $sql = SQL::Abstract->new;
 
-    my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
+    my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
 
     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
 
@@ -591,7 +605,7 @@ C<cmp> to C<like> you would get SQL such as:
 
     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
 
-You can also override the comparsion on an individual basis - see
+You can also override the comparison on an individual basis - see
 the huge section on L</"WHERE CLAUSES"> at the bottom.
 
 =item sqltrue, sqlfalse
@@ -830,8 +844,8 @@ the source.
 The argument can be either an arrayref (interpreted as a list
 of field names, will be joined by commas and quoted), or a
 plain scalar (literal SQL, not quoted).
-Please observe that this API is not as flexible as for
-the first argument C<$table>, for backwards compatibility reasons.
+Please observe that this API is not as flexible as that of
+the first argument C<$source>, for backwards compatibility reasons.
 
 =item $where
 
@@ -1123,7 +1137,8 @@ would generate:
     )";
     @bind = ('2000');
 
-
+Finally, if the argument to C<-in> is not a reference, it will be
+treated as a single-element array.
 
 Another pair of operators is C<-between> and C<-not_between>,
 used with an arrayref of two values:
@@ -1188,15 +1203,19 @@ then you should use the and/or operators:-
     my %where  = (
         -and           => [
             -bool      => 'one',
-            -bool      => 'two',
-            -bool      => 'three',
-            -not_bool  => 'four',
+            -not_bool  => { two=> { -rlike => 'bar' } },
+            -not_bool  => { three => [ { '=', 2 }, { '>', 5 } ] },
         ],
     );
 
 Would give you:
 
-    WHERE one AND two AND three AND NOT four
+    WHERE
+      one
+        AND
+      (NOT two RLIKE ?)
+        AND
+      (NOT ( three = ? OR three > ? ))
 
 
 =head2 Nested conditions, -and/-or prefixes
@@ -1323,7 +1342,7 @@ Note that if you were to simply say:
         array => [1, 2, 3]
     );
 
-the result would porbably be not what you wanted:
+the result would probably not be what you wanted:
 
     $stmt = 'WHERE array = ? OR array = ? OR array = ?';
     @bind = (1, 2, 3);
@@ -1719,6 +1738,9 @@ can be as simple as the following:
 
     #!/usr/bin/perl
 
+    use warnings;
+    use strict;
+
     use CGI::FormBuilder;
     use SQL::Abstract;