The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Time::Local qw();
use POSIX       qw();

my %args = @macro_args;
my ( $t2arr, $arr2t ) = ( sub { gmtime($_[0]) },
                          sub { Time::Local::timegm(@_) } );
if ( my $time_standard = $args{time_standard} ) {
  if ( $time_standard eq 'local' ) {
    ( $t2arr, $arr2t ) = ( sub { localtime($_[0]) },
                           sub { Time::Local::timelocal(@_) } );
  } elsif ( $time_standard eq 'gm' ) {
  } else {
    die "date_8 'time_standard' must be either 'local' or 'gm'. 'gm' is the default.\n";
  }
}

my @month_lenths = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
my @leap_month_lenghts = @month_lenths;  $leap_month_lenghts[1]++;

$self->add_hook ( 'validate_hook',

  sub {
    $_[1] =~ /^(\d{4})(\d{2})(\d{2})$/ or 
      die "$_[1] is not a valid date"; 
    # quick month check
    $2 < 13 && $2 > 0 or die "$_[1] is not a valid date"; 
    # quick day check
    $3 < 32 && $3 > 0 or die "$_[1] is not a valid date"; 
    my $is_leap; 
    if($1 % 400 == 0) {
      $is_leap = 1;
    } elsif ($1 % 100 == 0) {
      undef $is_leap
    } elsif ($1 % 4 == 0) {
      $is_leap = 1;
    }
    my $last_day_in_month = $is_leap ? $leap_month_lenghts[ $2 - 1 ] 
                                     : $month_lenths[ $2 - 1 ];
    die "$_[1] not a valid date\n" if $last_day_in_month < $3;
    return;
  }

);

$self->add_method ( 'days_add',
                    sub {
                      $_[0]->get() =~ /^(\d{4})(\d{2})(\d{2})$/;
                      my ($y, $m, $d) = ( $1, $2, $3 );
                      my $time = $arr2t->( 0, 0, 0, $d, $m-1, $y );
                      my $seconds_offset = 86400 * ( $_[1] || 0 );
                      my $new_time = $time + $seconds_offset;
                      my @tm = $t2arr->( $new_time );
                      return ($tm[5]+1900) .
                        substr("00".($tm[4]+1),-2) .
                          substr("00".$tm[3],-2);
                    } );


$self->add_method ( 'today',
                    sub {
                      my $day_offset = $_[1] || 0;
                      my @tm = $t2arr->( time() + $day_offset * 86400 );
                      return ($tm[5]+1900) .
                        substr("00".($tm[4]+1),-2) .
                          substr("00".$tm[3],-2);
                    } );

$self->add_method ( 'diff_today',
                    sub {
                      $_[0]->get() =~ /^(\d{4})(\d{2})(\d{2})$/;
                      my ($y, $m, $d) = ( $1, $2, $3 );
                      my $time = $arr2t->( 0, 0, 0, $d, $m-1, $y );
                      return POSIX::floor ( (time() - $time) / 86400 );
                    } );

$self->add_method ( 'gmtime',
                    sub {
                      my ( $self, $days_offset ) = @_;
                      $self->get() =~ /^(\d{4})(\d{2})(\d{2})$/;
                      my ($y, $m, $d) = ( $1, $2, $3 );
                      my $time = $arr2t->( 0, 0, 0, $d, $m-1, $y );
                      if ( $days_offset ) {
                        $time += $days_offset * (60*60*24);
                      }
                      my @tm = $t2arr->( $time );
                      return @tm;
                    } );

$self->add_method ( 'timegm',
                    sub {
                      my ( $self, $time ) = @_;
                      my @tm = $t2arr->( $time );
                      return ($tm[5]+1900) .
                        substr("00".($tm[4]+1),-2) .
                          substr("00".$tm[3],-2);
                    } );