view release on metacpan or  search on metacpan

lib/Date/Piece.pm  view on Meta::CPAN

package Date::Piece;
$VERSION = v0.0.3;

use warnings;
use strict;
use Carp;

use Time::Piece;
{
  no warnings 'redefine';
  *Time::Piece::ymd = *Time::Piece::date = sub {
    my $t = shift;
    return Date::Piece->new($t->year, $t->mon, $t->mday);
  };
}

use base 'Date::Simple';

=head1 NAME

Date::Piece - efficient dates with Time::Piece interoperability

=head1 SYNOPSIS

  use Date::Piece qw(date);

  my $date = date('2007-11-22');
  my $time = $date->at('16:42:35');

  print $time, "\n"; # is a Time::Piece

You can also start from a Time::Piece object.

  use Time::Piece;
  use Date::Piece;

  my $time = localtime;
  my $date = $time->date; # also ymd()

  $date+=7;
  # seven days later
  print $date, "\n";

  # seven days later at the original time
  print $date->at($time), "\n";

=head1 ABOUT

This module allows you to do I<nominal> math on dates.  That is, rather
than worrying about time zones and DST while adding increments of
24*60**2 seconds to a date&time object, you simply discard the time
component and do math directly on the date.  If you need a time-of-day
on the calculated date, the at() method returns a Time::Piece object,
thus allowing you to be specific about the endpoints of a nominal
interval.

This is useful for constructs such as "tomorrow", "yesterday", "this
time tomorrow", "one week from today", "one month later", "my 31st
birthday", and various other not-necessarily-numeric intervals on the
arbitrary and edge-case-laden division of time known by most earthlings
as "the calendar."  That is, adding days or months is analogous to
counting squares or turning pages on a calendar.

This module extends Date::Simple and connects it to Time::Piece.  See
Date::Simple for more details.

=head1 Immutable

A Date::Piece object never changes.  This means that methods like add_months() always return a new object.

This does not I<appear> to be true with constructs such as C<$date++> or
C<$date+=7>, but what is actually happening is that perl treats the
variable as an lvalue and assigns the new object to it.  Thus, the
following is true:

  my $also_date = my $date = today;
  $date++;
  $date > $also_date;

=head1 Validation

Where Date::Simple returns false for invalid dates, I throw errors.

=head1 Convenient Syntax

You may import the functions 'date' and 'today' as well as the
unit-qualifiers 'years', 'months', and 'weeks'.

When loaded as -MDate::Piece with perl -e (and/or -E in 5.10), these
extremely short versions are exported by default:

  years  => 'Y',
  months => 'M',
  weeks  => 'W',
  date   => 'D',
  today  => 'CD', # mnemonic: Current Date

You may unimport any imported functions with the 'no Date::Piece'
directive.

=cut

=head1 Functions

=head2 today

This returns the current date.  Don't be afraid to use it in arithmetic.

  my $today = today;
  my $tomorrow = today + 1;

=head2 date

  my $new_year_is_coming = date('2007-12-31');

Equivalent to Date::Piece->new('2007-12-31');

Also takes year, month, day arguments.

  my $d = date($year, $month, $day);

=cut

lib/Date/Piece.pm  view on Meta::CPAN

=cut

sub leap_year {
  my $self = shift;
  return(Date::Simple::leap_year($self->year));
} # end subroutine leap_year definition
########################################################################

=head2 thru

Returns a list ala $start..$end (because overloading doesn't work with
the '..' construct.)  Will work forwards or backwards.

  my @list = $date->thru($other_date);

=cut

sub thru {
  my $self = shift;
  my $i = $self->iterator(@_);

  my @ans;
  while(my $d = $i->()) { push(@ans, $d); }
  return(@ans);
} # end subroutine thru definition
########################################################################

=head2 iterator

Returns a subref which iterates through the dates between $date and
$other_date (inclusive.)

  my $subref = $date->iterator($other_date);
  while(my $day = $subref->()) {
    # do something with $day
  }

=cut

sub iterator {
  my $self = shift;
  my ($other) = @_;
  ref($other) or $other = ref($self)->new($other);

  my $diff = $other - $self;
  my $abs_d = abs($diff);
  my $dir = $abs_d ? $diff/$abs_d : 1;
  my $count = 0;
  my $ref = sub {
    ($count++ > $abs_d) and return;
    my $now = $self; $self += $dir;
    return($now);
  };
} # end subroutine iterator definition
########################################################################

=head1 Fuzzy Math

We can do math with months and years as long as you're flexible about
the day of the month.  The theme here is to keep the answer within the
destination calendar month rather than adding e.g. 30 days.

=head2 adjust_day_of_month

Returns a valid date even if the given day is beyond the last day of the
month (returns the last day of that month.)

  $date = adjust_day_of_month($y, $m, $maybe_day);

=cut

sub adjust_day_of_month {
  my (@ymd) = @_;

  (@ymd == 3) or croak(
    "adjust_day_of_month() must have 3 arguments, not ", scalar(@ymd));

  if($ymd[2] > 28) { # optimize
    my $dim = Date::Simple::days_in_month(@ymd[0,1]);
    $ymd[2] = $dim if($ymd[2] > $dim);
  }
  
  return(@ymd);
} # end subroutine adjust_day_of_month definition
########################################################################

=head2 add_months

Adds $n I<nominal> months to $date.  This will just be a simple
increment of the months (rolling-over at 12) as long as the day part is
less than 28.  If the destination month doesn't have as many days as the
origin month, the answer will be the last day of the destination month
(via adjust_day_of_month().)

  my $shifted = $date->add_months($n);

Note that if $day > 28 this is not reversible.  One should not rely on
it for incrementing except in trivial cases where $day <= 28 (because
calling $date = $date->add_months(1) twice is not necessarily the same
result as $date = $date->add_months(2).)

=cut

sub add_months {
  my $self = shift;
  my ($months) = @_;

  return($self->add_years($months/12)) unless($months % 12);

  my @ymd = $self->as_ymd;

  # get raw month number, bound, and carry to years
  my $nm = $ymd[1]+$months;
  my $m  = $nm % 12 || 12;
  my $ya = ($nm - $m)/12;
  $ymd[0] += $ya;
  $ymd[1] = $m;
  return($self->new(adjust_day_of_month(@ymd)));
} # end subroutine add_months definition
########################################################################