lib/DBIx/Class/SQLMaker/DateOps.pm

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