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