lib/DBIx/Class/SQLMaker/DateOps.pm

   1 package DBIx::Class::SQLMaker::DateOps;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/
   7   Class::Accessor::Grouped
   8 /;
   9 __PACKAGE__->mk_group_accessors (simple => qw/datetime_parser/);
  10 use Sub::Name 'subname';
  11 use Scalar::Util 'blessed';
  12
  13 sub _where_op_CONVERT_DATETIME {
  14   my $self = shift;
  15   my ($op, $rhs) = splice @_, -2;
  16   $self->throw_exception("-$op takes a DateTime only") unless ref $rhs && $rhs->isa('DateTime');
  17
  18   # in case we are called as a top level special op (no '=')
  19   my $lhs = shift;
  20
  21   $rhs = $self->datetime_parser->format_datetime($rhs);
  22
  23   my @bind = [
  24     ($lhs || $self->{_nested_func_lhs} || undef),
  25     $rhs
  26   ];
  27
  28   return $lhs
  29     ? (
  30       $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
  31       @bind
  32     )
  33     : (
  34       $self->_convert('?'),
  35       @bind
  36     )
  37   ;
  38 }
  39
  40 sub _unsupported_date_extraction {
  41    "date part extraction not supported for part \"$_[1]\" with database \"$_[2]\""
  42 }
  43
  44 sub _unsupported_date_adding {
  45    "date part adding not supported for part \"$_[1]\" with database \"$_[2]\""
  46 }
  47
  48 sub _unsupported_date_diff {
  49    "date diff not supported for part \"$_[1]\" with database \"$_[2]\""
  50 }
  51
  52 sub _datetime_sql { die 'date part extraction not implemented for this database' }
  53
  54 sub _datetime_diff_sql { die 'date diffing not implemented for this database' }
  55 sub _datetime_add_sql { die 'date adding not implemented for this database' }
  56
  57 sub _where_op_GET_DATETIME {
  58   my ($self) = @_;
  59
  60   my ($k, $op, $vals);
  61
  62   if (@_ == 3) {
  63      $op = $_[1];
  64      $vals = $_[2];
  65      $k = '';
  66   } elsif (@_ == 4) {
  67      $k = $_[1];
  68      $op = $_[2];
  69      $vals = $_[3];
  70   }
  71
  72   $self->throw_exception('args to -dt_get must be an arrayref') unless ref $vals eq 'ARRAY';
  73   $self->throw_exception('first arg to -dt_get must be a scalar or ARRAY ref') unless !ref $vals->[0] || ref $vals->[0] eq 'ARRAY';
  74
  75   my $part = $vals->[0];
  76   my $val  = $vals->[1];
  77
  78   my ($sql, @bind) = $self->_dt_arg_transform('', $val);
  79
  80   if (!ref $part) {
  81     return $self->_datetime_sql($part, $sql), @bind;
  82   } elsif (ref $part eq 'ARRAY' ) {
  83     return ( join ', ', map { $self->_datetime_sql($_, $sql) } @$part ), (@bind) x @$part;
  84   }
  85 }
  86
  87 for my $part (qw(month year hour minute second)) {
  88    no strict 'refs';
  89    my $name = '_where_op_GET_DATETIME_' . uc($part);
  90    *{$name} = subname "DBIx::Class::SQLMaker::DateOps::$name", sub {
  91      my $self = shift;
  92      my ($op, $rhs) = splice @_, -2;
  93
  94      my $lhs = shift;
  95
  96      return $self->_where_op_GET_DATETIME($op, $lhs, [$part, $rhs])
  97    }
  98 }
  99
 100 sub _where_op_GET_DATETIME_DAY {
 101   my $self = shift;
 102   my ($op, $rhs) = splice @_, -2;
 103
 104   my $lhs = shift;
 105
 106   # we use day_of_month instead of plain day internally
 107   # because some databases also support day_of_week and day_of_year
 108   return $self->_where_op_GET_DATETIME($op, $lhs, [day_of_month => $rhs])
 109 }
 110
 111 sub _where_op_DATETIME_NOW {
 112   my ($self) = @_;
 113
 114   my ($k, $op, $vals);
 115
 116   if (@_ == 3) {
 117      $op = $_[1];
 118      $vals = $_[2];
 119      $k = '';
 120   } elsif (@_ == 4) {
 121      $k = $_[1];
 122      $op = $_[2];
 123      $vals = $_[3];
 124   }
 125
 126   $self->throw_exception("args to -$op must be an arrayref") unless ref $vals eq 'ARRAY';
 127   if (!exists $vals->[0]) {
 128      return $self->_datetime_now_sql()
 129   } elsif ($vals->[0] eq 'system') {
 130      require DateTime;
 131      return $self->_where_op_CONVERT_DATETIME('dt', DateTime->now);
 132   } else {
 133      $self->throw_exception("first arg to -$op must be a 'system' or non-existant")
 134   }
 135 }
 136
 137 sub _reorder_add_datetime_vars {
 138    my ($self, $amount, $date) = @_;
 139
 140    return ($amount, $date);
 141 }
 142
 143 sub _dt_arg_transform {
 144    my $self = shift;
 145
 146    my ($k, $val) = @_;
 147
 148    if (blessed $val && $val->isa('DateTime')) {
 149      return (
 150        $self->_convert('?'),
 151        [
 152          \'timestamp',
 153          $self->datetime_parser->format_datetime($val)
 154        ]
 155      )
 156    }
 157
 158    $self->_dt_arg_non_date_transform(@_);
 159 }
 160
 161 sub _dt_arg_non_date_transform {
 162   my ($self, $k, $val) = @_;
 163
 164   my ($sql, @bind) = $self->_SWITCH_refkind($val, {
 165      SCALAR => sub {
 166        return ($self->_convert('?'), $self->_bindtype($k, $val) );
 167      },
 168      SCALARREF => sub {
 169        return $$val;
 170      },
 171      ARRAYREFREF => sub {
 172        my ($sql, @bind) = @$$val;
 173        $self->_assert_bindval_matches_bindtype(@bind);
 174        return ($sql, @bind);
 175      },
 176      HASHREF => sub {
 177        my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
 178        $self->$method('', $val);
 179      }
 180   });
 181   return ($sql, @bind);
 182 }
 183
 184 sub _where_op_ADD_DATETIME_transform_args { $_[0]->_dt_arg_non_date_transform($_[2], $_[3]) }
 185
 186 sub _where_op_ADD_DATETIME {
 187   my ($self) = @_;
 188
 189   my ($k, $op, $vals);
 190
 191   if (@_ == 3) {
 192      $op = $_[1];
 193      $vals = $_[2];
 194      $k = '';
 195   } elsif (@_ == 4) {
 196      $k = $_[1];
 197      $op = $_[2];
 198      $vals = $_[3];
 199   }
 200
 201   $self->throw_exception("args to -$op must be an arrayref") unless ref $vals eq 'ARRAY';
 202   $self->throw_exception("first arg to -$op must be a scalar") unless !ref $vals->[0];
 203   $self->throw_exception("-$op must have two more arguments") unless scalar @$vals == 3;
 204
 205   my ($part, @rest) = @$vals;
 206
 207   my (@all_sql, @all_bind);
 208   my $i = 0;
 209   foreach my $val ($self->_reorder_add_datetime_vars(@rest)) {
 210     my ($sql, @bind) = $self->_where_op_ADD_DATETIME_transform_args($i, $k, $val);
 211     push @all_sql, $sql;
 212     push @all_bind, @bind;
 213     $i++;
 214   }
 215
 216   return $self->_datetime_add_sql($part, $all_sql[0], $all_sql[1]), @all_bind
 217 }
 218
 219 sub _reorder_diff_datetime_vars {
 220    my ($self, $d1, $d2) = @_;
 221
 222    return ($d1, $d2);
 223 }
 224
 225 sub _where_op_DIFF_DATETIME {
 226   my ($self) = @_;
 227
 228   my ($k, $op, $vals);
 229
 230   if (@_ == 3) {
 231      $op = $_[1];
 232      $vals = $_[2];
 233      $k = '';
 234   } elsif (@_ == 4) {
 235      $k = $_[1];
 236      $op = $_[2];
 237      $vals = $_[3];
 238   }
 239
 240   $self->throw_exception('args to -dt_diff must be an arrayref') unless ref $vals eq 'ARRAY';
 241   $self->throw_exception('first arg to -dt_diff must be a scalar') unless !ref $vals->[0];
 242   $self->throw_exception('-dt_diff must have two more arguments') unless scalar @$vals == 3;
 243
 244   my ($part, @val) = @$vals;
 245   my $placeholder = $self->_convert('?');
 246
 247   @val = $self->_reorder_diff_datetime_vars(@val);
 248   my (@all_sql, @all_bind);
 249   foreach my $val (@val) {
 250     my ($sql, @bind) = $self->_dt_arg_non_date_transform($k, $val);
 251     push @all_sql, $sql;
 252     push @all_bind, @bind;
 253   }
 254
 255   return $self->_datetime_diff_sql($part, $all_sql[0], $all_sql[1]), @all_bind
 256 }
 257
 258 sub _where_op_CIRCA_DATETIME {
 259   my ($self) = @_;
 260
 261   my ($k, $op, $val);
 262
 263   if (@_ == 3) {
 264      $op = $_[1];
 265      $val = $_[2];
 266      $k = '';
 267   } elsif (@_ == 4) {
 268      $k = $_[1];
 269      $op = $_[2];
 270      $val = $_[3];
 271   }
 272
 273   my ($sql, @bind) = $self->_dt_arg_non_date_transform($k, $val);
 274
 275   my ($equal, $before, $after) = $op =~ /dt_(on_or_)?(before)?(after)?/;
 276   my $sym = $before
 277    ? '<'
 278    : '>'
 279   ;
 280
 281   $sym .= $equal
 282    ? '='
 283    : ''
 284   ;
 285   return "$k $sym $sql", @bind;
 286 }
 287
 288 1;