view release on metacpan or  search on metacpan

lib/DBIx/Class/Helper/ResultSet/DateMethods1.pm  view on Meta::CPAN

         sub {
            my ($date_sql, $part) = @_;

            my ($sql, @args) = @$date_sql;

            return [
               "EXTRACT($part_map{$part} FROM TO_TIMESTAMP($sql))", @args
            ]
         }
      });

      my %diff_part_map = %part_map;
      $diff_part_map{day} = delete $diff_part_map{day_of_month};
      delete $diff_part_map{$_} for qw(year month);
      $d->decorate_driver_unconnected(Oracle => dateadd_sql => sub {
         sub {
            my ($date_sql, $unit, $amount_sql) = @_;

            my ($d_sql, @d_args) = @{$date_sql};
            my ($a_sql, @a_args) = @{$amount_sql};

            die "unknown unit $unit" unless $diff_part_map{$unit};

            return [
               "(TO_TIMESTAMP($d_sql) + NUMTODSINTERVAL($a_sql, ?))",
               @d_args, @a_args, $diff_part_map{$unit}
            ];
         }
      });
      $d->decorate_driver_unconnected(Oracle => datesubtract_sql => sub {
         sub {
            my ($date_sql, $unit, $amount_sql) = @_;

            my ($d_sql, @d_args) = @{$date_sql};
            my ($a_sql, @a_args) = @{$amount_sql};

            die "unknown unit $unit" unless $diff_part_map{$unit};

            return [ # no idea if this works..
               "(TO_TIMESTAMP($d_sql) - NUMTODSINTERVAL($a_sql, ?))",
               @d_args, @a_args, $diff_part_map{$unit}
            ];
         }
      });
   }
   return $d;
}

use namespace::clean;


sub delete {
   my $self = shift;

   $self = $self->as_subselect_rs
      if $self->_resolved_attrs->{_DBICH_DM1};

   return $self->next::method(@_);
}

sub update {
   my $self = shift;

   $self = $self->as_subselect_rs
      if $self->_resolved_attrs->{_DBICH_DM1};

   return $self->next::method(@_);
}

sub utc {
   my ($self, $datetime) = @_;

   my $tz_name = $datetime->time_zone->name;

   die "floating dates are not allowed"
      if $tz_name eq 'floating';

   $datetime = $datetime->clone->set_time_zone('UTC')
      unless $tz_name eq 'UTC';

   $_[0]->result_source->storage->datetime_parser->format_datetime($datetime)
}

sub dt_before {
   my ($self, $l, $r) = @_;

   my ($l_sql, @l_args) = _flatten_thing($self, $l);
   my ($r_sql, @r_args) = _flatten_thing($self, $r);

   return $self->search(\[
      "$l_sql < $r_sql", @l_args, @r_args
   ], { _DBICH_DM1 => 1 });
}

sub dt_on_or_before {
   my ($self, $l, $r) = @_;

   my ($l_sql, @l_args) = _flatten_thing($self, $l);
   my ($r_sql, @r_args) = _flatten_thing($self, $r);

   $self->search(\[
      "$l_sql <= $r_sql", @l_args, @r_args
   ], { _DBICH_DM1 => 1 });
}

sub dt_on_or_after {
   my ($self, $l, $r) = @_;

   my ($l_sql, @l_args) = _flatten_thing($self, $l);
   my ($r_sql, @r_args) = _flatten_thing($self, $r);

   return $self->search(\[
      "$l_sql >= $r_sql", @l_args, @r_args
   ], { _DBICH_DM1 => 1 });
}

sub dt_after {
   my ($self, $l, $r) = @_;

   my ($l_sql, @l_args) = _flatten_thing($self, $l);
   my ($r_sql, @r_args) = _flatten_thing($self, $r);