view release on metacpan or  search on metacpan

lib/DateTime/Moonpig.pm  view on Meta::CPAN

use strict;
use warnings;
package DateTime::Moonpig;
{
  $DateTime::Moonpig::VERSION = '1.03';
}
# ABSTRACT: a DateTime object with different math

use base 'DateTime';
use Carp qw(confess croak);
use overload
  '+' => \&plus,
  '-' => \&minus,
;
use Scalar::Util qw(blessed reftype);
use Sub::Install ();

use namespace::autoclean;

sub new {
  my ($base, @arg) = @_;
  my $class = ref($base) || $base;

  if (@arg == 1) { return $class->from_epoch( epoch => $arg[0] ) }

  my %arg = @arg;
  $arg{time_zone} = 'UTC' unless exists $arg{time_zone};
  bless $class->SUPER::new(%arg) => $class;
}

sub new_datetime {
  my ($class, $dt) = @_;
  bless $dt->clone => $class;
}

# $a is expected to be epoch seconds
sub plus {
  my ($self, $a) = @_;
  my $class = ref($self);
  my $a_sec = $class->_to_sec($a);
  return $class->from_epoch( epoch     => $self->epoch + $a_sec,
                             time_zone => $self->time_zone,
                           );
}

sub minus {
  my ($a, $b, $rev) = @_;
  # if $b is a datetime, the result is an interval
  # but if $b is an interval, the result is another datetime
  if (blessed($b)) {
    if ($b->can("as_seconds")) {
      croak "subtracting a date from a scalar object is forbidden"
        if $rev;
      return $a->plus( - $b->as_seconds );
    } elsif ($b->can("epoch")) {
      my $res = ( $a->epoch - $b->epoch ) * ($rev ? -1 : 1);
      return $a->interval_factory($res);
    } else {
      croak "Can't subtract X from $a when X has neither 'as_seconds' nor 'epoch' method";
    }
  } elsif (ref $b) {
    croak "Can't subtract unblessed " . reftype($b) . " reference from $a";
  } else { # $b is a number
    croak "subtracting a date from a number is forbidden"
      if $rev;
    return $a + (-$b);
  }
}

sub number_of_days_in_month {
  my ($self) = @_;
  return (ref $self)
          ->last_day_of_month(year => $self->year, month => $self->month)
          ->day;
}

for my $mutator (qw(
  add_duration subtract_duration
  truncate
  set
    _year _month _day _hour _minute _second _nanosecond
)) {
  (my $method = $mutator) =~ s/^_/set_/;
  Sub::Install::install_sub({
    code => sub { confess "Do not mutate DateTime objects! (http://rjbs.manxome.org/rubric/entry/1929)" },
    as   => $method,
  });
}

sub interval_factory { return $_[1] }

sub _to_sec {
  my ($self, $a) = @_;