throw toys out the pram and convert to Moo

diff --git a/Makefile.PL b/Makefile.PL
index ddb1eef..01393c6 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -18,6 +18,7 @@ requires 'Scalar::Util' => 0;
 requires 'Class::Accessor::Grouped' => 0.10005;
 requires 'Getopt::Long::Descriptive' => 0.091;
 requires 'Hash::Merge' => 0.12;
+requires 'Moo' => '0.009014';
 
 test_requires "Test::More"      => 0.92;
 test_requires "Test::Exception" => 0;

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index abff01f..ff11248 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -5,9 +5,7 @@ package SQL::Abstract; # see doc at end of file
 # the test / diffusion / acceptance phase; those are marked with flag
 # 'LDNOTE' (note by laurent.dami AT free.fr)
 
-use strict;
 use Carp ();
-use warnings FATAL => 'all';
 use List::Util ();
 use Scalar::Util ();
 use Data::Query::Constants qw(
@@ -15,6 +13,7 @@ use Data::Query::Constants qw(
   DQ_WHERE DQ_DELETE DQ_UPDATE DQ_INSERT
 );
 use Data::Query::ExprHelpers qw(perl_scalar_value);
+use Moo;
 
 #======================================================================
 # GLOBALS
@@ -27,13 +26,6 @@ $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev relea
 
 our $AUTOLOAD;
 
-# special operators (-in, -between). May be extended/overridden by user.
-# See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
-my @BUILTIN_SPECIAL_OPS = ();
-
-# unaryish operators - key maps to handler
-my @BUILTIN_UNARY_OPS = ();
-
 #======================================================================
 # DEBUGGING AND ERROR REPORTING
 #======================================================================
@@ -59,42 +51,40 @@ sub puke (@) {
 # NEW
 #======================================================================
 
-sub new {
-  my $self = shift;
-  my $class = ref($self) || $self;
-  my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
+has case => (
+  is => 'ro', coerce => sub { $_[0] eq 'lower' ? 'lower' : undef }
+);
 
-  # choose our case by keeping an option around
-  delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
+has logic => (
+  is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
+);
 
-  # default logic for interpreting arrayrefs
-  $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
+has bindtype => (
+  is => 'ro', default => sub { 'normal' }
+);
 
-  # how to return bind vars
-  # LDNOTE: changed nwiger code : why this 'delete' ??
-  # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
-  $opt{bindtype} ||= 'normal';
+has cmp => (is => 'ro', default => sub { '=' });
 
-  # default comparison is "=", but can be overridden
-  $opt{cmp} ||= '=';
 
   # try to recognize which are the 'equality' and 'unequality' ops
   # (temporary quickfix, should go through a more seasoned API)
-  $opt{equality_op}   = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
-  $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
 
-  # SQL booleans
-  $opt{sqltrue}  ||= '1=1';
-  $opt{sqlfalse} ||= '0=1';
+has equality_op => (
+  is => 'ro', lazy => 1,
+  default => sub { qr/^(\Q${\$_[0]->cmp}\E|is|(is\s+)?like)$/i }
+);
+
+has inequality_op => (
+  is => 'ro',
+  default => sub { qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i }
+);
 
-  # special operators
-  $opt{special_ops} ||= [];
-  # regexes are applied in order, thus push after user-defines
-  push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
+  # SQL booleans
+has sqltrue => (is => 'ro', default => sub { '1=1' });
+has sqlfalse => (is => 'ro', default => sub { '0=1' });
 
-  # unary operators
-  $opt{unary_ops} ||= [];
-  push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
+has special_ops => (is => 'ro', default => sub { [] });
+has unary_ops => (is => 'ro', default => sub { [] });
 
   # rudimentary saniy-check for user supplied bits treated as functions/operators
   # If a purported  function matches this regular expression, an exception is thrown.
@@ -104,28 +94,42 @@ sub new {
   # FIXME
   # need to guard against ()'s in column names too, but this will break tons of
   # hacks... ideas anyone?
-  $opt{injection_guard} ||= qr/
-    \;
-      |
-    ^ \s* go \s
-  /xmi;
-
-  $opt{renderer} ||= do {
-    require Data::Query::Renderer::SQL::Naive;
-    my ($always, $chars);
-    for ($opt{quote_char}) {
-      $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
-    }
-    Data::Query::Renderer::SQL::Naive->new({
-      quote_chars => $chars, always_quote => 1,
-      ($opt{name_sep} ? (identifier_sep => $opt{name_sep}) : ()),
-      ($opt{case} ? (lc_keywords => 1) : ()), # always 'lower' if it exists
-    });
-  };
 
-  $opt{name_sep} ||= '.';
+has injection_guard => (
+  is => 'ro',
+  default => sub {
+    qr/
+      \;
+        |
+      ^ \s* go \s
+    /xmi;
+  }
+);
+
+has renderer => (is => 'lazy');
+
+has name_sep => (is => 'ro', default => sub { '.' });
+
+has quote_char => (is => 'ro');
 
-  return bless \%opt, $class;
+has always_quote => (is => 'ro', default => sub { 1 });
+
+has convert => (is => 'ro');
+
+has array_datatypes => (is => 'ro');
+
+sub _build_renderer {
+  my ($self) = @_;
+  require Data::Query::Renderer::SQL::Naive;
+  my ($chars);
+  for ($self->quote_char) {
+    $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
+  }
+  Data::Query::Renderer::SQL::Naive->new({
+    quote_chars => $chars, always_quote => $self->always_quote,
+    identifier_sep => $self->name_sep,
+    ($self->case ? (lc_keywords => 1) : ()), # always 'lower' if it exists
+  });
 }
 
 sub _render_dq {
@@ -133,7 +137,7 @@ sub _render_dq {
   if (!$dq) {
     return '';
   }
-  my ($sql, @bind) = @{$self->{renderer}->render($dq)};
+  my ($sql, @bind) = @{$self->renderer->render($dq)};
   wantarray ?
     ($self->{bindtype} eq 'normal'
       ? ($sql, map $_->{value}, @bind)
@@ -178,10 +182,10 @@ sub _value_to_dq {
 sub _ident_to_dq {
   my ($self, $ident) = @_;
   $self->_assert_pass_injection_guard($ident)
-    unless $self->{renderer}{quote_chars}[0] && $self->{renderer}{always_quote};
+    unless $self->renderer->quote_chars->[0] && $self->renderer->always_quote;
   $self->_maybe_convert_dq({
     type => DQ_IDENTIFIER,
-    elements => [ split /\Q${\$self->{renderer}->identifier_sep}/, $ident ],
+    elements => [ split /\Q${\$self->renderer->identifier_sep}/, $ident ],
   });
 }