http://qs1969.pair.com?node_id=262902
Category: Miscellaneous
Author/Contact Info nite_man
Description: Update: This module is an OO Perl interface for management of dates and provides wide enough functionality for this. I developed this module with my colleague and it is very useful for us. I hope that this module will be useful for someone at list.
=head1 NAME

C<Date> - Provides a class that can be used to manipulate date and tim
+e fields in an
object oriented approach.

=head1 VERSION

This document currently refers to version B<1.00> of C<Date> module.

=cut
package Date;

#use Apache::Reload; # need only for running under mod_perl
use Time::Local;
use strict;
use 5.6.0;

# global constants
use constant 't_60_60' => 3600;
use constant 't_60_60_24' =>  86400;

# The vars statement predeclares package names, so that they can be us
+ed in their unqualified form: $VERSION.
# use vars should be used only for things that actually need to be glo
+bal variables, like the @ISA array.
# Ordinary program variables should almost alway be lexically scoped w
+ith my.
use vars qw( 
    $VERSION
    @ISA
    @EXPORT
    $dformats
    %WeekDayNums 
    %MonthNums 
    @MonthDays 
    @MonthLong 
    @MonthShort 
    @WeekDayLong 
    @WeekDayLong 
    @WeekDayShort
    $zoneoffset      
);

##############################################################
# Package Initialization. Called when loading class module.
##############################################################
BEGIN
{
     # Define Version number 
     $VERSION = '1.00';
     require Exporter;    
     @ISA = qw(Exporter);
      @EXPORT = qw( datetime str2date datecomp interval);
     
     # calculate localzone offset from GMT in seconds
     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) 
+= localtime(0);
     $zoneoffset = ( ($hour+ 1) * t_60_60) + ($min*60) + $sec;
}

$dformats = {
    'us'    => '"$mon-$day-$year $hour:$min:$sec"',
    'br'    => '"$day-$mon-$year $hour:$min:$sec"',
    'db'    => '"$year-$mon-$day $hour:$min:$sec"',
    'd_us'  => '"$mon-$day-$year"',
    'd_br'  => '"$day-$mon-$year"',
    'd_db'  => '"$year-$mon-$day"',
    'time'  => '"$hour:$min:$sec"',
    'perl'  => '"$weekday $month $day $hour:$min:$sec $year"', 
    'http'  => '"$weekday, $day-$month-$year $hour:$min:$sec GMT"',
    'index' => '"$year$mon$day$hour$min$sec"',
    'rus'   => '"$weekday_long, $day $month_long $year, $hour:$min:$se
+c"',
    'd_long' => '"$day $month_long $year"',
};

@WeekDayShort = (qw[Sun Mon Tue Wed Thu Fri Sat]);
@WeekDayLong = (qw[Sunday Monday Tuesday Wednesday Thursday Friday Sat
+urday]);
@MonthShort = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]);
@MonthLong = (qw[January February March April May June July August Sep
+tember October November December]);
@MonthDays = (qw[31 x 31 30 31 30 31 31 30 31 30 31]);
@WeekDayNums{qw[sun mon tue wed thu fri sat]}=(0..6);
@MonthNums{qw[jan feb mar apr may jun jul aug sep oct nov dec]}=(0..11
+);

use overload   '<=>' => "datecomp", 
               '=='  => "_d_eq",
               '!='  => "_d_ne",
               '<='  => "_d_le",
               '>='  => "_d_ge",
               '<'   => "_d_lt",
               '>'   => "_d_gt",
               '""' => "get";
               
##############################################################
# Class constructor. Can accept optionally two parameters (in any orde
+r)
# 1st is 'time': as rerurned fro tme function that is seconds after 19
+70
# 2nd is 'zone': that can be either 'local' or 'gmt'
# is possible to clone an object by calling 'new' from an active objec
+t
##############################################################
sub new {
    # The 1st argument is always the Class name or object reference.
    my $proto = shift;
    my $class = ref($proto) || $proto;
        
    my $self = {};
        
    if (ref($proto)) { # clone the object 
        foreach my $key (keys %$proto) { $self->{$key} = $proto->{$key
+}; }
    }
    else { # is new date object
        my( $ctime, $zone );
        if ((lc($_[0]) ne 'gmt') and (lc($_[0]) ne 'local')) {
           $ctime = scalar(@_)>0 ? shift : time;
           $zone = lc($_[0]) eq 'gmt' ? 'gmt' : 'local';
        }
        else {
           $zone = shift; 
           $zone = lc($zone);
           $ctime = scalar(@_)>0 ? shift : time;
        } 
        $self->{'__zone'} = $zone;
        $self->{'__ctime'} = $ctime; 
        $self->{'__yoffset'} = 1900;
    }
    bless $self, $class;
    _refresh($self);
    return $self;
}

# Exported constructor. Can be used without class reference
# Can accept the same parameters are standard constructor. if no param
+eters
# are specified it will return current datetime
sub datetime {
    my $self = Date->new(@_);
    return $self;
}

# Another Exported constructor. Can be used without class reference
# Can accept as input parameter a datetime string that will be convert
+ed to date object
sub str2date {
    # if first argument is object reference then skip object creation
    my $self;
    if ( !ref($_[0]) ) { 
       $self = Date->new(); 
    }
    else { 
       $self = shift; 
    }
    return $self->set(@_);
}

######################################################################
+#################################
# Class Private Methods
######################################################################
+#################################

# operator overloading methods
sub _d_eq { return (datecomp(@_) == 0); } # '==' 
sub _d_ne { return (datecomp(@_) != 0); } # '!=' 
sub _d_le { return (datecomp(@_) <= 0); } # '<=' 
sub _d_ge { return (datecomp(@_) >= 0); } # '>=' 
sub _d_lt { return (datecomp(@_) <  0); } # '<'  
sub _d_gt { return (datecomp(@_) >  0); } # '>'  

# Refresh date object fileds by recalculating them from the assigned t
+ime values (seconds since 1/1/1970 00:00:00) 
sub _refresh {
    my $self = shift;

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
              !defined($self->{'__ctime'}) ? undef : 
              ( 
                $self->{'__zone'} eq 'gmt' 
                             ? gmtime($self->{'__ctime'}) 
                        : localtime($self->{'__ctime'}) 
              );

    $self->{'hour'} = $hour;
    $self->{'min'} = $min;
    $self->{'sec'} = $sec;
    $self->{'mday'} =  $mday;
    $self->{'mon'} = $mon;
    $self->{'year'} = $year;
    $self->{'wday'} = $wday;
    $self->{'yday'} = $yday;
    $self->{'isdst'} = $isdst;
}

# if the input day is too high for given months, returns the highest p
+ossible day for that month,
# otherwise returns the input day
sub _maxday {
    my ($day, $month, $year) = @_;
    my $maxday = days_in_month( {}, $month, $year);
    $day > $maxday and return $maxday;
    return $day;
}

# Extract date fields from an input string. Supported date formats are
+:
#           14 Jan 2001 | 14 JAN 01 | 14JAN2001 | Jan 14, 2001 | Jan 1
+4, 01
#           01-14-01 | 1-14-01 | 1-7-01 | 01-14-2001 | 2001-01-14
# NOTICE: When no clear decision can be made if is EUROPEAN format or 
+US we use
# EUROPEAN format dd/mm/yyyy 
sub _getdate {
  my ($val, $day, $month, $year) = @_;
  
  if ($val =~ s/^(\d+) ([a-z]+) (\d+)//) {           # 14 Jan 2001 | 1
+4 JAN 01 | 14JAN2001
    $day = $1;
    $month = $MonthNums{$2};
    $year = $3;
  }
  elsif ($val =~ s/^([a-z]+) (\d+) (\d+)//) {         # Jan 14, 2001 |
+ Jan 14, 01
    $month = $MonthNums{$1};
    $day = $2;
    $year = $3;
  }
  elsif ($val =~ s/^([a-z]+) (\d+)//) {                 # Jan 2001 | J
+an 01
    $month = $MonthNums{$1};
    $year = $2;
  }
  elsif ($val =~ s/^(\d+) (\d+) (\d+)//) {             # 01-14-01 | 1-
+14-01 | 1-7-01 | 01-14-2001 | 2001-1-14
      if ($1>999) { # ISO: year is first
        $year = $1;
        $month = $2-1;
        $day = $3;
    }
    elsif ($2>12 and $1<=12) { # US: month is first and day is second
        $month = $1 - 1;
        $day = $2;
        $year = $3;
    } 
    else {   # EUROPEAN: day is first and then month
        $day = $1;
        $month = $2 - 1;
        $year = $3;
    }
  }
  
  return ($val, $day, $month, $year);
}

# Extract time fields from an input string. Supported time formats are
+:
#           5pm | 5:34 pm | 
#           17:34 | 17:34:13 | 5:34:13 | 5:34:13 pm 
sub _gettime {
  my $str = shift;
  my ($hour, $min, $sec);
  
  # clean up a little
  $str =~ s/^://;
  $str =~ s/:$//;
  $str =~ s/(\d)(am|pm)/$1 $2/;
  
  if ($str =~ s/^(\d+):(\d+):(\d+) (a|p)(m|\b)\s*//) {   # 5:34:13 pm 
+| 5:34:13 p
    $hour = _ampmhour($1, $4);
    $min = $2;
    $sec = $3;
  }
  elsif ($str =~ s/^(\d+):(\d+):(\d+)\s*//) {               # 17:34:13
    $hour = $1;
    $min = $2;
    $sec = $3;
  }
  elsif ($str =~ s/^(\d+):(\d+) (a|p)m{0,1}\s*//) {        # 5:34 pm
    $hour = _ampmhour($1, $3);
    $min = $2;
  }
  elsif ($str =~ s/^(\d+):(\d+)\s*//) {                       # 17:34
    $hour = $1;
    $min = $2;
  }
  elsif ($str =~ s/^(\d+) (a|p)m{0,1}\b\s*//) {             # 5 pm
      $hour = _ampmhour($1, $2)
  }
  return ($str, $hour, $min, $sec);
}

sub _zeropad {
    my $rv = shift;
    my $length =  shift || 2;
    return ('0' x ($length - length($rv))) . $rv;
}

# Convert AM/PM hour to 24 hour format
sub _ampmhour {
    my ($hour, $ampm)=@_;
      if (($hour==12) and ($ampm =~ m/^a/)) {$hour = 0;}      # if 12a
+m set to 0
    elsif ($ampm =~ m/^p/)                {$hour += 12}   # else if pm
+, add 12
    return $hour;
}

# calulate the difference between two years in seconds
sub _s_ydiff {
    my($y1, $y2) = @_;
    my $ret = 0;
    for (my $li=$y1 ; $li<$y2 ; $li++) {
        $ret += is_leapyear( undef, $li) ? 366 : 365; 
    }
    return $ret*t_60_60_24;        
}

# Calulate the difference between two years in days
sub _d_ydiff {
    my($y1, $y2) = @_;
    my $ret = 0;
    for (my $li=$y1 ; $li<$y2 ; $li++) {
        $ret += is_leapyear( undef, $li) ? 366 : 365; 
    }
    return $ret;        
}


######################################################################
+#################################
# Class Public Methods
######################################################################
+#################################

# Returns 1 onl yif specified year is a leap year. If no year is pecif
+ied is
# examining current datetime year
sub is_leapyear {
    my $self = shift;
    my $year = shift || $self->{'year'}+$self->{'__yoffset'};
    
    return 1 if ( ($year % 4 == 0) && ( ($year % 100) || ($year % 400 
+== 0) ) );
    return 0;
}

# Returns number of days of a specific month of a year. 
# If year parameter is not specified is using current datetime year. 
# If NO parameters are specified returns number of days of current mon
+th
sub days_in_month {
    my $self = shift;
    my $month = shift || $self->{'mon'}+1;
    my $year = shift || $self->{'year'}+$self->{'__yoffset'};
    
    if ($month != 2)       { return $MonthDays[$month-1]; }
    if (is_leapyear($self, $year)) { return 29; }
    return 28;
}

# Returns seconds within day for current datime object since last midn
+ight
sub secs_in_day {
    my $self = shift;
    return ($self->{'hour'}*t_60_60) + ($self->{'min'}*60) + $self->{'
+sec'};
}

# Read or modify curent datetime zone
sub zone {
    my $self = shift;
    if ( @_>0 ) { 
       $self->{'__zone'} = lc($_[0]) eq 'gmt' ? 'gmt' : 'local' ;
       _refresh($self);
    }
    return $self->{'__zone'};
}

# Set current datetime object to current time 
sub now {
    my $self = shift;
    
    $self->{'__yoffset'} = 1900;
    $self->{'__ctime'} = time;
    _refresh($self);
    return $self;
}

# Compare two date objects. Method returns:
#   1 : if first date is greater than second date
#  -1 : if first date is smaller than second date
#   0 : if dates are equal
# This method is exported by the module and can be called as:
#         if ( datecomp($d1,$d2) != 0 } .....
#               - or -
#         if ( $d1->datecomp($d2) != 0 } .....    
sub datecomp {
    my $d1 = shift; # first date object
    my $d2 = shift; # second date object
    my $diff;
    
    # first check days diferrence and then examine diferrence in secon
+ds
    $diff = $d1->datediff('day',$d2);
    if ( $diff>0 )  {return 1;}
    elsif ($diff<0) {return -1;}
    
    # if came here that means datetimes are within the same day
    $diff = $d1->datediff('sec',$d2);
    if ( $diff>0 )  {return 1;}
    elsif ($diff<0) {return -1;}
    
    # if came here means the dates are equal
    return 0;
}

# Returns any part of datetime value. Available options are:
#     'hour'              : Hour 0..24
#    'min'            : Minute 0..59
#    'sec'            : Seconds 0..59
#    'day'            : Day of month 0..31
#    'mon'            : Month 1..12
#    'year'            : Year (4 digit)
#   'wday'          : weekday 0..6
#    'weekday'        : Short name of week day
#    'weekday_long'    : Full name of week day 
#    'yearday'        : Day of year 1..365
#    'month'            : Short name of month
#    'month_long'    : Full name of month
sub datepart {
    my $self = shift;
    my $part = shift;
    my $ret;
    
    if( !defined($self->{'__ctime'}) ) { return undef }
    
    if    ( $part eq 'hour' )         { $ret = $self->{'hour'}; }
    elsif ( $part eq 'min' )           { $ret = $self->{'min'}; }
    elsif ( $part eq 'sec' )           { $ret = $self->{'sec'}; }
    elsif ( $part eq 'day' )           { $ret = $self->{'mday'}; }
    elsif ( $part eq 'mon' )           { $ret = $self->{'mon'}+1; }
    elsif ( $part eq 'year' )             { $ret = $self->{'year'}+$se
+lf->{'__yoffset'}; }
    elsif ( $part eq 'wday' )           { $ret = $self->{'wday'}; }
    elsif ( $part eq 'weekday' )       { $ret = $WeekDayShort[ $self->
+{'wday'} ]; }
    elsif ( $part eq 'weekday_long' ) { $ret = $WeekDayLong[ $self->{'
+wday'} ]; }
    elsif ( $part eq 'yearday' )       { $ret = $self->{'yday'}; }
    elsif ( $part eq 'month' )              { $ret = $MonthShort[ $sel
+f->{'mon'} ]; }
    elsif ( $part eq 'month_long' )   { $ret = $MonthLong[ $self->{'mo
+n'} ]; }
  
    return $ret;
}

# Add (substruct if minus) any number of specified units to current da
+time object. 
# Available options are:
#     'hour'              : Add (+/-) any number of Hours
#    'min'            : Add (+/-) any number of Minutes
#    'sec'            : Add (+/-) any number of Seconds
#    'day'            : Add (+/-) any number of Days
#    'mon'            : Add (+/-) any number of Months
#    'year'            : Add (+/-) any number of Years
# the only restriction is that the resulted date time mus be within 19
+70 - 2030
sub dateadd {
    my $self  = shift;
    my $part  = shift || 'day';
    my $value = shift || 1;
    
    if( !defined($self->{'__ctime'}) ) { return undef }
    
    if    ( $part eq 'hour' )         { $self->{'__ctime'} += $value *
+ t_60_60; }
    elsif ( $part eq 'min' )           { $self->{'__ctime'} += $value 
+* 60; }
    elsif ( $part eq 'sec' )           { $self->{'__ctime'} += $value;
+ }
    elsif ( $part eq 'day' )           { $self->{'__ctime'} += $value 
+* t_60_60_24; }
    elsif ( ($part eq 'mon') or ($part eq 'year') ) {
        my ($months, $mon, $day, $year);
        if ($part eq 'mon') {
           $months = $self->{'mon'} + $value;
              $mon = $months % 12;
           $year = $self->{'year'} + int($months/12) + $self->{'__yoff
+set'};
           if ($months<0) { $year--; }
        } 
          else {
           $mon = $self->{'mon'};
           $year = $self->{'year'} + $value + $self->{'__yoffset'};
        }
        $day = _maxday( $self->{'mday'}, $mon+1, $year);
        
        # fix year offset if year is outside boundaries (1970~2038)
        if ($year<1971 or $year>2035) {
           my $dif = 2000 - $year;
           $dif = int($dif/28) * 28;
           $year += $dif;
           $self->{'__yoffset'} = 1900-$dif;   
        }
        else {$self->{'__yoffset'} = 1900;}
        
          $self->{'__ctime'} = $self->{'__zone'} eq 'gmt'
                           ? timegm($self->{'sec'}, $self->{'min'}, $s
+elf->{'hour'}, $day, $mon, $year)
                           : timelocal($self->{'sec'}, $self->{'min'},
+ $self->{'hour'}, $day, $mon, $year);
    }
     _refresh($self);    
    return $self;   
}


# Compares current datetime object wit another one and return the dife
+rrence in specified units
#     'hour'              : Hour 0..24
#    'min'            : Minute 0..59
#    'sec'            : Seconds 0..59
#    'day'            : Day of month 0..31
#    'mon'            : Month 1..12
#    'year'            : Year (4 digit)
# For 'hour', 'min', and 'sec' method returns the actual diferrence bu
+t for 'day', 'month' and 'year' are
# based on calendar diference. 
sub datediff {
    my $self = shift;
    my $part = shift;
    my $dd = shift;  # other object reference that dates will be compa
+red

    if (!defined($dd)) {return 0;}
    if( !defined($self->{'__ctime'}) ) { return undef }

    my ($off_s, $off_d, $ret, $zoff);    
    my $t1 = $self->{'__ctime'};
    my $t2 = $dd->{'__ctime'};

    if ( ($part eq 'hour') or ($part eq 'min') or ($part eq 'sec')) {
           # calculate diferrence in seconds between dates offset (ini
+tial year)
        $off_s = _s_ydiff( $self->{'__yoffset'}, $dd->{'__yoffset'} );

        # calculate difference between date zones in seconds
        if ($self->{'__zone'} eq $dd->{'__zone'} ) { $zoff = 0; }
        elsif ($self->{'__zone'} eq 'gmt')         { $zoff = $zoneoffs
+et; }
        else                                       { $zoff = -$zoneoff
+set; }
    } 
    elsif ($part eq 'day') {
       # calculate diferrence in days between dates offset (initial ye
+ar)
        $off_d = _d_ydiff( $self->{'__yoffset'}, $dd->{'__yoffset'} );
    } 
         
    if    ( $part eq 'hour' )         { $ret = int(($t1 - $t2 + $off_s
+ + $zoff)/ t_60_60); }
    elsif ( $part eq 'min' )           { $ret = int(($t1 - $t2 + $off_
+s + $zoff)/ 60); }
    elsif ( $part eq 'sec' )           { $ret = $t1 - $t2 + $off_s + $
+zoff; }
    elsif ( $part eq 'day' ) { 
          $ret = int((($t1-$self->secs_in_day) - ($t2 - $dd->secs_in_d
+ay))/ t_60_60_24) + $off_d ;
    }
    elsif ( $part eq 'mon' ) { 
          $ret = 12*( ($self->{'year'}+$self->{'__yoffset'})-($dd->{'y
+ear'}+ $dd->{'__yoffset'})) + 
                 + $self->{'mon'} - $dd->{'mon'} ; 
    }
    elsif ( $part eq 'year' ) { 
          $ret = ($self->{'year'} + $self->{'__yoffset'}) - 
                 ($dd->{'year'}   + $dd->{'__yoffset'}); 
    }
    return $ret;
}

# This method is used to set a specific part of date object to a speci
+fic value 
# Available options are:
#     'hour'              : Set to specific Hour
#    'min'            : Set to specific Minutes
#    'sec'            : Set to specific Seconds
#    'day'            : Set to specific Day
#    'mon'            : Set to specific Month
#    'year'            : Set to specific Year
# You are able to pass any number of 'part' => 'value' pairs as parame
+ters
sub set_part {
    my $self  = shift;
    my %parts = @_; # should be a hash of 'part' => 'value' pairs
    my ($part, $value);
    
    if( !defined($self->{'__ctime'}) ) { return $self }
    
    my %newval = ( hour => $self->{'hour'}, 
                   min  => $self->{'min'}, 
                   sec  => $self->{'sec'}, 
                   day  => $self->{'mday'}, 
                   mon  => $self->{'mon'}, 
                   year => $self->{'year'}
                  );
    
    while ( ($part, $value) = each(%parts)) {

        if    ( $part eq 'hour') { $newval{'hour'} = $value%24; }
        elsif ( $part eq 'min' ) { $newval{'min'}  = $value%60; }
        elsif ( $part eq 'sec' ) { $newval{'sec'}  = $value%60; }
        elsif ( $part eq 'day' ) { $newval{'day'}  = $value%31; }
        elsif ( $part eq 'mon' ) { 
            $newval{'mon'}  = ($value-1)%12; 
            # check if day is valid
            $newval{'day'} = _maxday( $newval{'day'}, $newval{'mon'}+1
+, $newval{'year'}+$self->{'__yoffset'} );
        }
        elsif ( $part eq 'year') {
            # normalize year
            if( $value<50 )    { $value += 2000 }
            elsif( $value<100) { $value +=1900 }
    
            # check if day is valid
            $newval{'day'} = _maxday( $newval{'day'}, $newval{'mon'}+1
+, $value);    
            
            # fix year offset if year is outside boundaries (1970~2038
+)
            if ($value<1971 or $value>2035) {
               my $dif = 2000 - $value;
               $dif = int($dif/28) * 28;
               $value += $dif;
               $self->{'__yoffset'} = 1900-$dif;   
            }
            else {$self->{'__yoffset'} = 1900;}
            $newval{'year'} = $value;
        }
    }
      $self->{'__ctime'} = $self->{'__zone'} eq 'gmt'
                       ? timegm($newval{'sec'}, $newval{'min'}, $newva
+l{'hour'}, $newval{'day'}, $newval{'mon'}, $newval{'year'})
                       : timelocal($newval{'sec'}, $newval{'min'}, $ne
+wval{'hour'}, $newval{'day'}, $newval{'mon'}, $newval{'year'});
     _refresh($self);    
    return $self;   
}

# Returns time as formatted string using one of the predefined formats
sub get {
    my $self = shift;
    my $fmtkey = shift || 'db';
    my $format = $dformats->{$fmtkey};    
    my ($sec, $min, $hour, $day, $mon, $year, $weekday, $yearday, $mon
+th, $weekday_long, $month_long);
    
    if( !defined($self->{'__ctime'}) ) { return ''}
    
    $hour  = _zeropad( $self->{'hour'});
    $min   = _zeropad( $self->{'min'} );
    $sec   = _zeropad( $self->{'sec'} );
    $day   = _zeropad( $self->{'mday'} );
    $mon   = _zeropad( $self->{'mon'}+1 );
    $year  = $self->{'year'} + $self->{'__yoffset'};
    $weekday = $WeekDayShort[ $self->{'wday'} ];
    $weekday_long = $WeekDayLong[ $self->{'wday'} ];
    $yearday = $self->{'yday'};
    $month = $MonthShort[ $self->{'mon'} ];
    $month_long = $MonthLong[ $self->{'mon'} ];

    return eval($format);
}

# Extract date fields from an input string and assign proper values to
+ current object. 
# Supported date formats are:
#           14 Jan 2001 | 14 JAN 01 | 14JAN2001 | Jan 14, 2001 | Jan 1
+4, 01
#           01-14-01 | 1-14-01 | 1-7-01 | 01-14-2001 | 2001-01-14
# Supported time formats are:
#           5pm | 5:34 pm | 
#           17:34 | 17:34:13 | 5:34:13 | 5:34:13 pm
# Notice also that it can handle anu AC date starting from 01/01/0000
sub set {
    my $self = shift;
      my ($val, %opts) = @_;
    my ($hour, $min, $sec, $day, $month, $year);
    my $orgval = $val;
  
    # Quick return: if they just put in an integer use it as time valu
+e
    if( !defined($val) or $val =~ m/^\d+$/) {
       $self->{'__ctime'} = $val;
       $self->{'__yoffset'} = 1900;
       _refresh($self);
       return $self;
    }

    # normalize
    $val = lc($val);
    $val =~ s/[^\w:]/ /g;
    $val =~ s/\s*:\s*/:/g;
    $val =~ s/(\d)([a-z])/$1 $2/g;
    $val =~ s/([a-z])(\d)/$1 $2/g;
    $val =~ s/\s+/ /g;
    $val =~ s/^\s*//;
    $val =~ s/\s*$//;
    $val =~ s/([a-z]{3})[a-z]+/$1/g;
    
    # remove weekday
    $val =~ s/((sun)|(mon)|(tue)|(wed)|(thu)|(fri)|(sat))\s*//;
    $val =~ s/\s*$//;

    # attempt to get time
    unless ($opts{'dateonly'}) {
      ($val, $hour, $min, $sec) = _gettime($val);
    }

    # attempt to get date
    unless ($opts{'timeonly'}) {
      if (length $val) {($val, $day, $month, $year) = _getdate($val)}
    }

    # trim
    $val =~ s/^\s*//;

    # attempt to get time again
    unless ($opts{'dateonly'}) {
      if (length($val) && (! defined($hour)) ) {($val, $hour, $min, $s
+ec) = _gettime($val);}
    }

    # default everything that isn't defined
    unless (defined $hour)  {$hour = $self->{'hour'}}
    unless (defined $min)   {$min = $self->{'min'}}
    unless (defined $sec)   {$sec = $self->{'sec'}}
    unless (defined $month) {$month = $self->{'mon'}}
    unless (defined $year)  {$year = $self->{'year'}+$self->{'__yoffse
+t'}}
    unless (defined $day)   {$day = _maxday($self->{'mday'}, $month, $
+year)}

    # set year to four digits
    if (length($year) == 2) {$year = substr($self->{'year'}, 0, 2) . $
+year}
    
    # fix year offset if year is outside boundaries (1970~2038)
    if ($year<1971 or $year>2035) {
       my $dif = 2000 - $year;
       $dif = int($dif/28) * 28;
       $year += $dif;
       $self->{'__yoffset'} = 1900-$dif;   
    }
    else {$self->{'__yoffset'} = 1900;}
        
    $self->{'__ctime'} = $self->{'__zone'} eq 'gmt'
                       ? timegm($sec, $min, $hour, $day, $month, $year
+)
                       : timelocal($sec, $min, $hour, $day, $month, $y
+ear);
    _refresh($self);
    return $self;
}

########################################
#
#return time interval in the format
# hours:minutes:secobds
# parameters : 
# 1. interval in seconds
# 2. format [4 or 's'|2 or 'm'|3 or 'h' default 's'
# THIS IS A CLASS METHOD!
#######################################
sub interval {
    
    my $allSec = shift;
    $_ = shift; # time format
    # convert passed timeValue to seconds
    SWITCH: {
        defined($_) || last; # default seconds
        $allSec *= 60, last if /[mM2]/;
        $allSec*= 3600, last if /[hH3]/;
    }        

    my $restSec = $allSec % 3600;
    # create an array with hours, minutes and seconds
    my @parsedInterval = (int($allSec/ 3600), int($restSec / 60), $res
+tSec % 60);

    my $len;
    my $intervalStr;
    for (@parsedInterval) {
        if (($len = length($_)) <= 2) {
            $intervalStr .= '0'x(2 - $len) . "$_:" ;
        } else {
            $intervalStr .= "$_:" ;
        }
    }
    $intervalStr =~ s/:$//;

    return $intervalStr;
}

1;

=pod

=head1 SYNOPSIS

    # use the module. By default exports C<datetime()> and C<str2date(
+)> methods.   
    use Date;
    
    # Constructors
    my $dd = Date->new(0,'gmt'); # emtry date 1900-01-01 00:00:00 GMT
    my $de = datetime;             # current date and time
    my $df = str2date('21-09-2003 19:24:14');
    
    # get formatted date        
    print $dd->get("us") . "\n";
    print $dd->get("br") . "\n";
    print $dd->get("perl") . "\n";
    print $de->get("db") . "\n";    
    print $de->get("index") . "\n";
    print $df->get("http") . "\n";
    
    print $de->datepart("weekday_long") . "\n";
    print $df->datepart("time") . "\n";
    
    
    # date manipulation methods
    $df->set('Tue, 31-Jul-2001 11:24:14 GMT');
    $df->set('07-17-2001');
    $de->str2date('21-09-2003 19:24:14'); # shortcut to set. Work also
+ as constructor
    print $dd->set('Tue, 31-Jul-2001 11:24:14')->get('db'); # initiali
+ze object and return 'db' formatted string 

    $dd->set_part(day => 24, mon => 2); 
    $dd->set_part(year => 2023, hour => 12);
    $dd->set_part( hour=>13, min=>1, sec=>59); # 13:01:59
      
    $de->dateadd('mon',2);
    $de->dateadd('hour',-4);
    $dd->dateadd('day'); # by default incease by one
    print $dd->dateadd->get('db'); # shows next day date as 'db' forma
+tted string
    
    
    print 'Diff Year => ' . $df->datediff('year',$de) . "\n";
    print 'Diff Month => ' . $df->datediff('mon',$de) . "\n";
    print 'Diff Day => ' . $df->datediff('day',$de) . "\n";
    print 'Diff Hour => ' . $df->datediff('hour',$de) . "\n";
    print 'Diff Minutes => ' . $df->datediff('min',$de) . "\n";
    print 'Diff Seconds => ' . $df->datediff('sec',$de) . "\n";
    
    # other helpful method
    print $df->secs_in_day;  # Returns seconds since last midnight
    if ($dd->is_leapyear) { print "Curent year is leap!" }
    if ($dd->is_leapyear(2007) { print "Year 2007 is leap!" }
    print 'Current month has ' . $dd->days_in_month . ' days!';
    print 'Feb of 2003 has ' . $dd->days_in_month(2,2003) . ' days!'; 
    
    print $dd->zone; # Print curent datetime zone (gmt|local)
    $dd->zone('local'); # change timezone to local (time is automatica
+lly updated
    
    # overloaded operators
    print "$df"; # print date by using dafault format that is 'db'    
    print "# $df" . ' >'   . "$de \n" if $df > $de;
    print "# $df" . ' == ' . "$df \n" if $df == $df;
    print "# $de" . ' < '  . "$df \n" if $de < $df;
    print "# $de" . ' <= ' . "$df \n" if $de <= $df;
    print "# $df" . ' >= ' . "$de \n" if $df >= $de;
    print "# $df" . ' <> ' . "$de \n" if $df != $de;


=head1 DESCRIPTION

=head2 1. Overview

This module provides a set of class that is used for datetime fields m
+anipulation in an object oriented approach.
This class is bypassing perl boundaries on date (1970 .. 2038) and can
+ be used with any AC dates. 

=head2 2. Constructors

=over  

=item * C<new( [time], [zone] )>

Class constructor. Can optionally accept two parameters (in any order)
+:

    'time': as rerurned from C<time> function that is seconds after 01
+/01/1970 00:00:00
    'zone': that can be either 'local' or 'gmt'

Also, by calling C<new> from an active object reference is possible to
+ clone an object.

    my $dd = Date->new(0,'gmt'); # emtry date 1900-01-01 00:00:00 GMT
    my $df = $dd->new();                 # assigned the same value

=item * C<datetime( [time], [zone] )>

Exported constructor. Can be used without class reference as:

    my $de = datetime;   # current date and time

This method can accept the same parameters as the standard C<new> cons
+tructor. If no parameters
are specified it will create a datetime object based of current date a
+nd time.

=item * C<str2date( str_time )>

This is another exported constructor. Can be used without class refere
+nce as:

     my $df = str2date('21-09-2003 19:24:14');

Can accept as input parameter any valid datetime string and convert it
+ to a datetime object. 
I<All valid datetime string will be presented in> C<set()> I<method)>.
+ In addition this method can be referenced 
by a any active object and in that case it will just update the value 
+of the current datetime object. For example:

     $df->str2date('2001-03-01 19:24:14');

=back

=head2 3. Methods

=over

=item * C<is_leapyear( [year] )>

Returns 1 only if specified year is a leap year. If no year has been p
+ecified method is examining 
the current datetime year.

=item * C<days_in_month( [month][,year] )>

Returns the number of days of a specific month of a year. 
If year parameter is not specified is using current datetime year. 
If ther is no parameters at all, method is returning the number of day
+s of current month.

=item * C<secs_in_day()>

Returns the number of seconds since last midnight for the current dati
+me object. 

=item * C<zone( ['gmt'|'local'] )>

Read or modify curent datetime zone. the only supported zones are C<'l
+ocal'> and C<'gmt'>. 

=item * C<now()>

Set datetime object to current time.

=item * C<datepart( part )>

Returns any part of current datetime object. Available options are:

    'hour'          : Hour 0..24
    'min'           : Minute 0..59
    'sec'           : Seconds 0..59
    'day'           : Day of month 0..31
    'mon'           : Month 1..12
    'year'          : Year (4 digit)
    'wday'          : weekday 0..6
    'weekday'       : Short name of week day
    'weekday_long'  : Full name of week day 
    'yearday'       : Day of year 1..365
    'month'         : Short name of month
    'month_long'    : Full name of month

=item * C<dateadd( [part][,value] )>

Add I<(substruct if (-))> any number of the specified units to current
+ datime object. 
In first parameter we should specify the type of units we are adding (
+if ommited then is using 'day').
Available options are:

    'hour'    : Add (+/-) any number of Hours
    'min'    : Add (+/-) any number of Minutes
    'sec'    : Add (+/-) any number of Seconds
    'day'    : Add (+/-) any number of Days
    'mon'    : Add (+/-) any number of Months
    'year'    : Add (+/-) any number of Years

The second parameter is specifying the number of units to add (or subs
+truct). If no C<value> parameter is
specified then is using C<1> as default. Another usefull feature is th
+at method returns the reference to current 
object and this allow as to write statements like:

    print $dd->dateadd->get('db'); # shows next day date as 'db' forma
+tted string 

=item * C<datediff( part, date_obj )> 

Compares current datetime object with another one and return the difer
+rence in units specified from first parameter.
Available options are:

     'hour'    : Hour 0..24
    'min'    : Minute 0..59
    'sec'    : Seconds 0..59
    'day'    : Day of month 0..31
    'mon'    : Month 1..12
    'year'    : Year (4 digit)

Notice that for 'hour', 'min', and 'sec' the method returns the actual
+ diferrence but for 'day', 'month' and 'year' 
the returned result is based on calendar diference. 

=item * C<datecomp( d_obj1, d_obj2 )>

This method is used to compare two date objects. Method returns:

     1 : if first date is greater than second date
    -1 : if first date is smaller than second date
     0 : if dates are equal

This method is exported by the module and can be called as:

    if ( datecomp($d1,$d2) != 0 ) { ..... }
    
or, references by a date object that is used as first argumernt in met
+hod:

    if ( $d1->datecomp($d2) != 0 ) { ..... }    

=item * C<get( [format] )>

Returns date and time as formatted string using one of the predefined 
+formats that is specified by the first parameter.
Available formats are:

    'us'    => '03-16-2001 14:19:59'
    'br'    => '16-03-2001 14:19:59'
    'db'    => '2001-03-16 14:19:59'
    'd_us'  => '03-16-2001'
    'd_br'  => '16-03-2001'
    'd_db'  => '2001-03-16'
    'time'  => '14:19:59'
    'perl'  => 'Tue Mar 16 14:19:59 2001' 
    'http'  => 'Tue 16-Mar-2001 14:19:59 GMT'
    'index' => '20010316141959'

=item * C<set( str_time )>

Extract date fields from an input string and assign proper values to c
+urrent object. 
The method can recognize the following date formats:

    14 Jan 2001 | 14 JAN 01 | 14JAN2001 | Jan 14, 2001 | Jan 14, 01
    01-14-01 | 1-14-01 | 1-7-01 | 01-14-2001 | 2001-01-14

and the following time formats:

    5pm | 5:34 pm | 5:34:13 pm
    17:34 | 17:34:13 | 5:34:13 

A usefull feature is that method returns the reference to current obje
+ct and this allow as to write statements like:

    # initialize object and return 'db' formatted string
    print $dd->set('Tue, 31-Jul-2001 11:24:14')->get('db'); 

=item * C<set_part( part=>value, ...)> 

This method is used to set specific part or parts of date object to a 
+specific value. 
We are bale in to pass any number of 'part' => 'value' pairs as parame
+ters and the method 
will return an updated object reference to it self. 
Valid optins as 'parts' are:

    'hour'    : Set to specific Hour
    'min'    : Set to specific Minutes
    'sec'    : Set to specific Seconds
    'day'    : Set to specific Day
    'mon'    : Set to specific Month
    'year'    : Set to specific Year

Here are few examples:

    $dd->set_part(day => 29, mon => 2); 
    $dd->set_part(year => 2023, hour => 12);
    $dd->set_part( hour=>13, min=>1, sec=>59); # 13:01:59

=back

=head2 4. Overloaded Operators

Current module oveloads numeric comparison operators, so they can be u
+sed to directly compare two date objects:

=over

    '<=>' : Return the same result as 'datecomp()' method, that is -1,
+0,1
    '=='  : Return 'true' (=1) if the two dates are equal. Otherwize r
+eturns 'false' (=0)
    '!='  : Return 'true' (=1) if the two dates are not equal. Otherwi
+ze returns 'false' (=0)
    '<='  : Return 'true' (=1) if first date is smaller or equal to se
+cond date. Otherwize returns 'false' (=0)
    '>='  : Return 'true' (=1) if first date is greater or equal to se
+cond date. Otherwize returns 'false' (=0)
    '<'   : Return 'true' (=1) if first date is smaller from second da
+te. Otherwize returns 'false' (=0)
    '>'   : Return 'true' (=1) if first date is greater from second da
+te. Otherwize returns 'false' (=0)
    '""'  : Converts any date objects that are enclosed in in double q
+uoted string, into a formated string by using default format that is 
+'db'.

=back

=head1 REQUIRES

    Apache::Reload, Exporter, Time::Local

=head1 EXPORTS

    datetime, str2date, datecomp

=cut
Replies are listed 'Best First'.
Re: Module "Date"
by rob_au (Abbot) on Jun 04, 2003 at 10:45 UTC
    Whilst not to disparage your effort in this code, I would direct you to the Perl DateTime project at http://datetime.perl.org. The goal of this project is to produce a suite of inter-operable Perl modules for handling dates and times and clear the murkiness surrounding the overlapping functionality and differing interfaces and implementations between modules.

    The advantages of using the DateTime family of modules are outlined on the frequently asked questions page on the project homepage:

    Hope this is of interest.

     

    perl -le 'print+unpack"N",pack"B32","00000000000000000000001001100110"'

        19 years ... Such a long time.
      Many thanks, rob_au, of course, your information very interesting for me. I'm agree with you and developers of Perl Date Time project about using modules of Date/Time family. And, of course, my module needs some redevelopments :))
            
      --------------------------------
      SV* sv_bless(SV* sv, HV* stash);
      
        I think that every interesting subject needs a first personal interpretation of the problem to be completelly aware of the real needs.

        Who knows if you should become an expert on this subject in a couple of years...?

        I am also interested in this strange lacking of good time administration of the basic Perl.(it seems that it allways backed on C code to solve this problem)

        I wish you good luck in this journey.

        At the Perl Date Time Project? (it recently looks a bit forgotten)

        And , please, keep on sharing your ideas about this subject!

Re: Module "Date"
by Anonymous Monk on Jun 04, 2003 at 09:35 UTC
    And what would be the benefit of using your module instead of Date::Calc?
      Main advantage of this module is its Object Oriented architecture and some features (for example, retriving a date/time format from hash). I think that it is power and flexible.
      Well, about using a module Date::Calc, I can find in the CPAN many modules for working with date and time and you can use each of them. I've published this module because I hope that its implementation and functionality will be useful for developers.But I don't assert that "this module is the best". Try to use it and maybe you will find some advantages yourself.
            
      --------------------------------
      SV* sv_bless(SV* sv, HV* stash);