view release on metacpan or  search on metacpan

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

package Class::Date;
our $AUTHORITY = 'cpan:YANICK';
# ABSTRACT: Class for easy date and time manipulation
$Class::Date::VERSION = '1.1.17';
use 5.006;

use strict;
use vars qw(
  @EXPORT_OK %EXPORT_TAGS @ISA
  $DATE_FORMAT $DST_ADJUST $MONTH_BORDER_ADJUST $RANGE_CHECK
  @NEW_FROM_SCALAR @ERROR_MESSAGES $WARNINGS 
  $DEFAULT_TIMEZONE $LOCAL_TIMEZONE $GMT_TIMEZONE
  $NOTZ_TIMEZONE $RESTORE_TZ
);
use Carp;

use Exporter;
use Time::Local;
use Class::Date::Const;
use Scalar::Util qw(blessed);
use POSIX;

use Class::Date::Rel;
use Class::Date::Invalid;

BEGIN { 
    $WARNINGS = 1 if !defined $WARNINGS;
    *timelocal = *Time::Local::timelocal_nocheck;
    *timegm = *Time::Local::timegm_nocheck;

    @ISA=qw(Exporter);
    %EXPORT_TAGS = ( errors => $Class::Date::Const::EXPORT_TAGS{errors});
    @EXPORT_OK = (qw( date localdate gmdate now @ERROR_MESSAGES), 
        @{$EXPORT_TAGS{errors}});

    *strftime_xs = *POSIX::strftime;
    *tzset_xs = *POSIX::tzset;
    *tzname_xs = *POSIX::tzname;
}

$GMT_TIMEZONE = 'GMT';
$DST_ADJUST = 1;
$MONTH_BORDER_ADJUST = 0;
$RANGE_CHECK = 0;
$RESTORE_TZ = 1;
$DATE_FORMAT="%Y-%m-%d %H:%M:%S";

sub _set_tz { my ($tz) = @_;
    my $lasttz = $ENV{TZ};
    if (!defined $tz || $tz eq $NOTZ_TIMEZONE) {
        # warn "_set_tz: deleting TZ\n";
        delete $ENV{TZ};
        Env::C::unsetenv('TZ') if exists $INC{"Env/C.pm"};
    } else {
        # warn "_set_tz: setting TZ to $tz\n";
        $ENV{TZ} = $tz;
        Env::C::setenv('TZ', $tz) if exists $INC{"Env/C.pm"};
    }
    tzset_xs();
    return $lasttz;
}

sub _set_temp_tz { my ($tz, $sub) = @_;
    my $lasttz = _set_tz($tz);
    my $retval = eval { $sub->(); };
    _set_tz($lasttz) if $RESTORE_TZ;
    die $@ if $@;
    return $retval;
}

tzset_xs();
$LOCAL_TIMEZONE = $DEFAULT_TIMEZONE = local_timezone();
{
    my $last_tz = _set_tz(undef);
    $NOTZ_TIMEZONE = local_timezone();
    _set_tz($last_tz);
}
# warn "LOCAL: $LOCAL_TIMEZONE, NOTZ: $NOTZ_TIMEZONE\n";

# this method is used to determine what is the package name of the relative
# time class. It is used at the operators. You only need to redefine it if
# you want to derive both Class::Date and Class::Date::Rel.
# Look at the Class::Date::Rel::ClassDate also.
use constant ClassDateRel => "Class::Date::Rel";
use constant ClassDateInvalid => "Class::Date::Invalid";

use overload 
  '""'     => "string",
  '-'      => "subtract",
  '+'      => "add",
  '<=>'    => "compare",
  'cmp'    => "compare",
  fallback => 1;

sub date ($;$) { my ($date,$tz)=@_;
  return __PACKAGE__ -> new($date,$tz);
}

sub now () { date(time); }

sub localdate ($) { date($_[0] || time, $LOCAL_TIMEZONE) }

sub gmdate    ($) { date($_[0] || time, $GMT_TIMEZONE) }

sub import {
  my $package=shift;
  my @exported;
  foreach my $symbol (@_) {
    if ($symbol eq '-DateParse') {
      if (!$Class::Date::DateParse++) {
        if ( eval { require Date::Parse } ) {
            push @NEW_FROM_SCALAR,\&new_from_scalar_date_parse;
        } else {
            warn "Date::Parse is not available, although it is requested by Class::Date\n" 
                if $WARNINGS;
        }
      }