initial cut for -dt op
Arthur Axel 'fREW' Schmidt [Sun, 30 Jan 2011 03:56:42 +0000 (21:56 -0600)]
lib/DBIx/Class/SQLMaker.pm
lib/DBIx/Class/Storage/DBI.pm
t/sqlmaker/op_dt.t [new file with mode: 0644]

index fbc3911..dfd5087 100644 (file)
@@ -73,7 +73,7 @@ use DBIx::Class::Carp;
 use DBIx::Class::Exception;
 use namespace::clean;
 
-__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
+__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect datetime_parser/);
 
 # for when I need a normalized l/r pair
 sub _quote_chars {
@@ -136,6 +136,11 @@ sub new {
     { regex => qr/^ value $/xi, handler => '_where_op_VALUE' },
     { regex => qr/^ func  $/ix, handler => '_where_op_FUNC'  },
     { regex => qr/^ op    $/ix, handler => '_where_op_OP'    },
+    { regex => qr/^ dt    $/xi, handler => '_where_op_CONVERT_DATETIME' },
+    { regex => qr/^ dt_get $/xi, handler => '_where_op_GET_DATETIME' },
+    { regex => qr/^ dt_diff $/xi, handler => '_where_op_DIFF_DATETIME' },
+    map +{ regex => qr/^ dt_$_ $/xi, handler => '_where_op_GET_DATETIME_'.uc($_) },
+      qw(year month day)
   );
 
   push @{$self->{special_ops}}, @extra_dbic_syntax;
@@ -162,6 +167,155 @@ sub _where_op_IDENT {
   ;
 }
 
+sub _where_op_CONVERT_DATETIME {
+  my $self = shift;
+  my ($op, $rhs) = splice @_, -2;
+  croak "-$op takes a DateTime only" unless ref $rhs  && $rhs->isa('DateTime');
+
+  # in case we are called as a top level special op (no '=')
+  my $lhs = shift;
+
+  $rhs = $self->datetime_parser->format_datetime($rhs);
+
+  my @bind = [
+    ($lhs || $self->{_nested_func_lhs} || croak "Unable to find bindtype for -value $rhs"),
+    $rhs
+  ];
+
+  return $lhs
+    ? (
+      $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
+      @bind
+    )
+    : (
+      $self->_convert('?'),
+      @bind
+    )
+  ;
+}
+
+{
+  my %part_map = (
+     month        => 'm',
+     day_of_month => 'd',
+     year         => 'Y',
+  );
+
+  sub _datetime_sql { "STRFTIME('$part_map{$_[1]}', $_[2])" }
+}
+
+sub _datetime_diff_sql {
+   my ($self, $part, $left, $right) = @_;
+   '(' .
+      $self->_datetime_sql($part, $left)
+       . ' - ' .
+      $self->_datetime_sql($part, $right)
+   . ')'
+}
+
+sub _where_op_GET_DATETIME {
+  my ($self) = @_;
+
+  my ($k, $op, $vals);
+
+  if (@_ == 3) {
+     $op = $_[1];
+     $vals = $_[2];
+     $k = '';
+  } elsif (@_ == 4) {
+     $k = $_[1];
+     $op = $_[2];
+     $vals = $_[3];
+  }
+
+  croak 'args to -dt_get must be an arrayref' unless ref $vals eq 'ARRAY';
+  croak 'first arg to -dt_get must be a scalar' unless !ref $vals->[0];
+
+  my $part = $vals->[0];
+  my $val  = $vals->[1];
+
+  my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+     SCALAR => sub {
+       return ($self->_convert('?'), $self->_bindtype($k, $val) );
+     },
+     SCALARREF => sub {
+       return $$val;
+     },
+     ARRAYREFREF => sub {
+       my ($sql, @bind) = @$$val;
+       $self->_assert_bindval_matches_bindtype(@bind);
+       return ($sql, @bind);
+     },
+     HASHREF => sub {
+       my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
+       $self->$method('', $val);
+     }
+  });
+
+  return $self->_datetime_sql($part, $sql), @bind;
+}
+
+for my $part (qw(month day year)) {
+   no strict 'refs';
+   my $name = '_where_op_GET_DATETIME_' . uc($part);
+   *{$name} = subname "DBIx::Class::SQLMaker::$name", sub {
+     my $self = shift;
+     my ($op, $rhs) = splice @_, -2;
+
+     my $lhs = shift;
+
+     return $self->_where_op_GET_DATETIME($op, $lhs, [$part, $rhs])
+   }
+}
+
+sub _where_op_DIFF_DATETIME {
+  my ($self) = @_;
+
+  my ($k, $op, $vals);
+
+  if (@_ == 3) {
+     $op = $_[1];
+     $vals = $_[2];
+     $k = '';
+  } elsif (@_ == 4) {
+     $k = $_[1];
+     $op = $_[2];
+     $vals = $_[3];
+  }
+
+  croak 'args to -dt_diff must be an arrayref' unless ref $vals eq 'ARRAY';
+  croak 'first arg to -dt_diff must be a scalar' unless !ref $vals->[0];
+  croak '-dt_diff must have two more arguments' unless scalar @$vals == 3;
+
+  my ($part, @val) = @$vals;
+  my $placeholder = $self->_convert('?');
+
+  my (@all_sql, @all_bind);
+  foreach my $val (@val) {
+    my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+       SCALAR => sub {
+         return ($placeholder, $self->_bindtype($k, $val) );
+       },
+       SCALARREF => sub {
+         return $$val;
+       },
+       ARRAYREFREF => sub {
+         my ($sql, @bind) = @$$val;
+         $self->_assert_bindval_matches_bindtype(@bind);
+         return ($sql, @bind);
+       },
+       HASHREF => sub {
+         my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
+         $self->$method('', $val);
+       }
+    });
+    push @all_sql, $sql;
+    push @all_bind, @bind;
+  }
+
+  return $self->_datetime_diff_sql($part, $all_sql[0], $all_sql[1]), @all_bind
+}
+
 sub _where_op_VALUE {
   my $self = shift;
   my ($op, $rhs) = splice @_, -2;
index 6c6efcc..f70d06d 100644 (file)
@@ -987,6 +987,7 @@ sub sql_maker {
       limit_dialect => $dialect,
       ($quote_char ? (quote_char => $quote_char) : ()),
       name_sep => ($name_sep || '.'),
+      datetime_parser => $self->datetime_parser,
       %opts,
     ));
   }
diff --git a/t/sqlmaker/op_dt.t b/t/sqlmaker/op_dt.t
new file mode 100644 (file)
index 0000000..693b5fb
--- /dev/null
@@ -0,0 +1,77 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+use DateTime;
+
+use_ok('DBICTest');
+
+my $schema = DBICTest->init_schema();
+
+my $sql_maker = $schema->storage->sql_maker;
+
+my $date = DateTime->new(
+   year => 2010,
+   month => 12,
+   day   => 14,
+   hour  => 12,
+   minute => 12,
+   second => 12,
+);
+
+my $date2 = $date->clone->set_day(16);
+
+is_same_sql_bind (
+  \[ $sql_maker->select ('artist', '*', { 'artist.when_began' => { -dt => $date } } ) ],
+  "SELECT *
+    FROM artist
+    WHERE artist.when_began = ?
+  ",
+  [['artist.when_began', '2010-12-14 12:12:12']],
+);
+
+is_same_sql_bind (
+  \[ $sql_maker->update ('artist',
+    { 'artist.when_began' => { -dt => $date } },
+    { 'artist.when_ended' => { '<' => { -dt => $date2 } } },
+  ) ],
+  "UPDATE artist
+    SET artist.when_began = ?
+    WHERE artist.when_ended < ?
+  ",
+  [
+   ['artist.when_began', '2010-12-14 12:12:12'],
+   ['artist.when_ended', '2010-12-16 12:12:12'],
+  ],
+);
+
+is_same_sql_bind (
+  \[ $sql_maker->select ('artist', '*', {
+    -and => [
+       { -op => [ '=', 12, { -dt_month => { -ident => 'artist.when_began' } } ] },
+       { -op => [ '=', 2010, { -dt_get => [year => \'artist.when_began'] } ] },
+       { -op => [ '=', 14, { -dt_get => [day_of_month => \'artist.when_began'] } ] },
+       { -op => [ '=', 10, { -dt_diff => [year => { -ident => 'artist.when_began' }, \'artist.when_ended'] } ] },
+    ]
+  } ) ],
+  "SELECT *
+     FROM artist
+     WHERE ( (
+       ( ? = STRFTIME('m', artist.when_began) ) AND
+       ( ? = STRFTIME('Y', artist.when_began) ) AND
+       ( ? = STRFTIME('d', artist.when_began) ) AND
+       ( ? = ( STRFTIME('Y', artist.when_began) - STRFTIME('Y', artist.when_ended)))
+     ) )
+  ",
+  [
+   ['', 12],
+   ['', 2010],
+   ['', 14],
+   ['', 10],
+  ],
+);
+
+done_testing;