File Coverage

blib/lib/Date/ICal.pm

Criterion	Covered	Total	%
statement	266	306	86.9
branch	95	128	74.2
condition	22	31	70.9
subroutine	38	45	84.4
pod	23	30	76.6
total	444	540	82.2

# $Rev: 681 $
package Date::ICal;
use strict;
use warnings;

use vars qw($VERSION $localzone $localoffset @months @leapmonths %add_units);
$VERSION = '2.'.(qw'$Rev: 681 $')[1];
use Carp;
use Time::Local;
use Date::Leapyear qw();
use Date::ICal::Duration;
use overload '<=>' => 'compare',
             'fallback' => 1,
             '-' => \&subtract,
             '+' => \&add_overload;

$localzone   = $ENV{TZ} || 0;
$localoffset = _calc_local_offset();

# Documentation {{{

=encoding utf8

=head1 NAME

Date::ICal - Perl extension for ICalendar date objects.

=head1 VERSION

$Revision: 681 $

=head1 SYNOPSIS

    use Date::ICal;

    $ical = Date::ICal->new( ical => '19971024T120000' );
    $ical = Date::ICal->new( epoch => time );
    $ical = Date::ICal->new( year => 1964,
        month => 10, day => 16, hour => 16,
        min => 12, sec => 47 );

    $hour = $ical->hour;
    $year = $ical->year;

    $ical_string = $ical->ical;
    $epoch_time = $ical->epoch;

    $ical2 = $ical + $duration;

(Where $duration is either a duration string, like 'P2W3DT7H9M', or a
Date::ICal::Duration (qv) object.

    $ical += 'P6DT12H';

    $duration = $ical - $ical2;
    $ical3 = $ical - $duration;

=head1 DESCRIPTION

Date::ICal talks the ICal date format, and is intended to be a base class for
other date/calendar modules that know about ICal time format also.

=head1 AUTHOR

Rich Bowen, and the Reefknot team. Alas, Reefknot is no more. See
L for more modern and accurate modules.

Last touched by $Author: michal-josef-spacek $

=head1 METHODS

Date::ICal has the following methods available:

=head2 new

A new Date::ICal object can be created with any valid ICal string:

    my $ical = Date::ICal->new( ical => '19971024T120000' );
    # will default to the timezone specified in $TZ, see below

Or with any epoch time:

    my $ical = Date::ICal->new( epoch => time );

Or, better still, create it with components

    my $date = Date::ICal->new(
                           day => 25,
                           month => 10,
                           year => 1066,
                           hour => 7,
                           min => 15,
                           sec => 47
                           );

If you call new without any arguments, you'll get a Date::ICal object that is
set to the time right now.

    my $ical = Date::ICal->new();

If you already have an object in Date::ICal, or some other subclass
thereof, you can create a new Date::ICal (or subclass) object using
that object to start with. This is particularly useful for converting
from one calendar to another:

   # Direct conversion from Discordian to ISO dates
   my $disco = Date::Discordian->new( disco => '12 Chaos, YOLD 3177' );
   my $iso = Date::ISO->new( $disco );
   print $iso->iso;

new() handles timezones. It defaults times to UTC (Greenwich
Mean Time, also called Zulu). If you want to set up a time
that's in the US "Pacific" timezone, which is GMT-8, use something
like:

    my $ical = Date::ICal->new( ical => '19971024T120000',
                                offset => "-0800");

Note that as of version 1.44, new() tries to be intelligent
about figuring out your local time zone. If you enter
a time that's not *explicitly* in UTC, it looks at
the environment variable $TZ, if it exists, to determine
your local offset. If $TZ isn't set, new() will complain.

=cut

#}}}

#{{{ sub new

sub new {
    my $class = shift;
    my ( $self, %args, $sec, $min, $hour, $day, $month, $year, $tz );

    # $zflag indicates whether or not this time is natively in UTC
    my $zflag = 0;

    # First argument can be a Date::ICal (or subclass thereof) object
    if ( ref $_[0] ) {
        $args{ical} = $_[0]->ical;
      } else {
        %args = @_;
    }

    $self = {};

    # Date is specified as epoch#{{{
    if ( defined( $args{epoch} ) ) {

        ( $sec, $min, $hour, $day, $month, $year ) =
          ( gmtime( $args{epoch} ) )[ 0, 1, 2, 3, 4, 5 ];
        $year += 1900;
        $month++;

        $zflag = 1;    # epoch times are by definition in GMT
    }    #}}}

    # Date is specified as ical string#{{{
    elsif ( defined( $args{ical} ) ) {

        # Timezone, if any
        $args{ical} =~ s/^(?:TZID=([^:]+):)?//;
        $tz = $1;

        # Split up ical string
        ( $year, $month, $day, $hour, $min, $sec, $zflag ) =
          $args{ical} =~ /^(?:(\d{4})(\d\d)(\d\d))
               (?:T(\d\d)?(\d\d)?(\d\d)?)?
                         (Z)?$/x;

        # TODO: figure out what to do if we get a TZID.
        # I'd suggest we store it for use by modules that care
        # about TZID names. But we don't want this module
        # to deal with timezone names, only offsets, I think.
        # --srl

    }    #}}}

    # Time specified as components#{{{
    elsif ( defined( $args{day} ) ) {

        # Choke if missing arguments
        foreach my $attrib(qw(day month year )) {
            warn "Attribute $attrib required" unless defined $args{$attrib};
        }
        foreach my $attrib(qw( hour min sec )) {
            $args{$attrib} = 0 unless defined $args{$attrib};
        }

        # And then just use what was passed in
        ( $sec, $min, $hour, $day, $month, $year ) =
          @args{ 'sec', 'min', 'hour', 'day', 'month', 'year' };

    }    #}}}

    else {    # Just use current gmtime#{{{

        # Since we are defaulting, this qualifies as UTC
        $zflag = 1;

        ( $sec, $min, $hour, $day, $month, $year ) = ( gmtime(time) )[ 0 .. 5 ];
        $year += 1900;
        $month++;
    }    #}}}

    $self->{julian} = greg2jd( $year, $month, $day );
    $self->{julsec} = time_as_seconds( $hour, $min, $sec );
    bless $self, $class;

    if ( exists( $args{offset} ) ) {
        # We should complain if they're trying to set a non-UTC
        # offset on a time that's inherently UTC.  -jv
        if ($zflag && ($args{offset} != 0)) {
            carp "Time had conflicting offset and UTC info. Using UTC"
              unless $ENV{HARNESS_ACTIVE};
          } else {

            # Set up the offset for this datetime.
            $self->offset( $args{offset} || 0 );
        }
      } elsif ( !$zflag ) {

        # Check if the timezone has changed since the last time we checked.
        # Apparently this happens on some systems. Patch from Mike
        # Heins. Ask him.
        my $tz  = $ENV{TZ} || '0';
        my $loc = $tz eq $localzone ? $localoffset : _calc_local_offset();
        $self->offset($loc) if defined $self;
    }

    return $self;
}

#}}}

#{{{ sub ical

=head2 ical

    $ical_string = $ical->ical;

Retrieves, or sets, the date on the object, using any valid ICal date/time
string. Output is in UTC (ends with a "Z") by default. To get
output in localtime relative to the current machine, do:

    $ical_string = $ical->ical( localtime => 1 );

To get output relative to an arbitrary offset, do:

    $ical_string = $ical->ical( offset => '+0545' );

=cut

sub ical {
    my $self = shift;
    if ( 1 & @_ ) {     # odd number of parameters?
        carp "Bad args: expected named parameter list";
        shift;    # avoid warning from %args=@_ assignment
    }
    my %args = @_;
    my $ical;

    if ( exists $args{localtime} ) {
        carp "can't have localtime and offset together, using localtime offset"
          if exists $args{offset};

        # make output in localtime format by setting $args{offset}
        $args{offset} = $self->offset;
    }

    if ( exists $args{offset} ) {

        # make output based on an arbitrary offset
        # No Z on the end!
        my $julian = $self->{julian};
        my $julsec = $self->{julsec};
        my $adjust = offset_to_seconds( $args{offset} );
        $self->add( seconds => $adjust );
        $ical =
          sprintf( '%04d%02d%02dT%02d%02d%02d', $self->year, $self->month,
          $self->day, $self->hour, $self->minute, $self->second, );
        $self->{julian} = $julian;
        $self->{julsec} = $julsec;
      } else {

        # make output in UTC by default
        # if we were originally given this time in offset
        # form, we'll need to adjust it for output
        if ( $self->hour || $self->min || $self->sec ) {
            $ical =
              sprintf( '%04d%02d%02dT%02d%02d%02dZ', $self->year, $self->month,
              $self->day, $self->hour, $self->minute, $self->second );
          } else {
            $ical =
              sprintf( '%04d%02d%02dZ', $self->year, $self->month, $self->day );
        }
    }

    return $ical;
}    #}}}

#{{{ sub epoch

=head2 epoch

    $epoch_time = $ical->epoch;

    $ical->epoch( 98687431 );

Sets, or retrieves, the epoch time represented by the object, if it is
representable as such. (Dates before 1971 or after 2038 will not have an epoch
representation.)

Internals note: The ICal representation of the date is considered the only
authoritative one. This means that we may need to reconstruct the epoch time
from the ICal representation if we are not sure that they are in synch. We'll
need to do clever things to keep track of when the two may not be in synch.
And, of course, the same will go for any subclasses of this class.

=cut

sub epoch {
    my $self  = shift;
    my $class = ref($self);

    my $epoch;

    if ( $epoch = shift ) {    # Passed in a new value

        my $newepoch = $class->new( epoch => $epoch );
        $self->{julian} = $newepoch->{julian};
        $self->{julsec} = $newepoch->{julsec};

    }

    else {    # Calculate epoch from components, if possible

        $epoch =
          timegm( $self->sec, $self->min, $self->hour, $self->day,
          ( $self->month ) - 1, $self->year );
    }

    return $epoch;
}

#}}}

#{{{ sub offset_to_seconds

=head2 offset_to_seconds

    $seconds_plus_or_minus = offset_to_seconds($offset);

Changes -0600 to -21600. Not object method, no side-effects.

=cut

sub offset_to_seconds {
    my $offset = shift;

    # Relocated from offset for re-use
    my $newoffset;

    if ( $offset eq '0' ) {
        $newoffset = 0;
      } elsif ( $offset =~ /^([+-])(\d\d)(\d\d)\z/ )
    {
        my ( $sign, $hours, $minutes ) = ( $1, $2, $3 );

        # convert to seconds, ignoring the possibility of leap seconds
        # or daylight-savings-time shifts
        $newoffset = $hours * 60 * 60 + $minutes * 60;
        $newoffset *= -1 if $sign eq '-';
      } else {
        carp("You gave an offset, $offset, that makes no sense");
        return undef;
    }
    return $newoffset;
}

#}}}

#{{{ sub offset_from_seconds

=head2 offset_from_seconds

    $seconds_plus_or_minus = offset_from_seconds($offset_in_seconds);

Changes -18000 (seconds) to -0600 (hours, minutes).
Not object method, no side-effects.

=cut

sub offset_from_seconds {
    my $secoffset  = shift;
    my $hhmmoffset = 0;

    if ( $secoffset ne '0' ) {
        my ( $sign, $secs ) = ( "", "" );
        ( $sign, $secs ) = $secoffset =~ /([+-])?(\d+)/;

        # throw in a + to make this look like an offset if positive
        $sign = "+" unless $sign;

        # NOTE: the following code will return "+0000" if you give it a number
        # of seconds that are a multiple of a day. However, for speed reasons
        # I'm not going to write in a comparison to reformat that back to 0.
        #
        my $hours = $secs / ( 60 * 60 );
        $hours = $hours % 24;
        my $mins = ( $secs % ( 60 * 60 ) ) / 60;
        $hhmmoffset = sprintf( '%s%02d%02d', $sign, $hours, $mins );

    }

    return $hhmmoffset;
}

#}}}

#{{{ sub offset

=head2 offset

    $offset = $ical->offset;

    # We need tests for these.
    $ical->offset( '+1100' ); # a number of hours and minutes: UTC+11
    $ical->offset( 0 );       # reset to UTC

Sets or retrieves the offset from UTC for this time. This allows
timezone support, assuming you know what your local (or non-local)
UTC offset is. Defaults to 0.

Internals note: all times are internally stored in UTC, even though they
may have some offset information. Offsets are internally stored in
signed integer seconds.

BE CAREFUL about using this function on objects that were initialized
with an offset. If you started an object with:

    my $d = new(ical=>'19700101120000', offset=>'+0100');

and you then call:

    $d->offset('+0200');

you'll be saying "Yeah, I know I *said* it was in +0100, but really I
want it to be in +0200 now and forever." Which may be your intention,
if you're trying to transpose a whole set of dates to another timezone---
but you can also do that at the presentation level, with
the ical() method. Either way will work.

=cut

sub offset {
    my ( $self, $offset ) = @_;
    my $newoffset = undef;

    if ( defined($offset) ) {    # Passed in a new value
        $newoffset = offset_to_seconds($offset);

        unless ( defined $newoffset ) { return undef; }

        # since we're internally storing in GMT, we need to
        # adjust the time we were given by the offset so that
        # the internal date/time will be right.

        if ( $self->{offset} ) {

            # figure out whether there's a difference between
            # the existing offset and the offset we were given.
            # If so, adjust appropriately.
            my $offsetdiff = $self->{offset} - $newoffset;

            if ($offsetdiff) {
                $self->{offset} = $newoffset;
                $self->add( seconds => $offsetdiff );
              } else {

                # leave the offset the way it is
            }
          } else {
            $self->add( seconds => -$newoffset );
            $self->{offset} = $newoffset;
        }

      } else {
        if ( $self->{offset} ) {
            $offset = offset_from_seconds( $self->{offset} );
          } else {
            $offset = 0;
        }
    }

    return $offset;
}

#}}}

# sub add {{{

=head2 add

    $self->add( year => 3, month => 2, week => 1, day => 12,
                hour => 1, min => 34, sec => 59 );
    $date->add( duration => 'P1WT1H1M1S' ); # add 1 wk, 1 hr, 1 min, and 1 sec

Adds a duration to a Date::ICal object.

Supported paraters are: duration, eom_mode, year, month, week, day,
hour, min, sec or seconds.

'duration' is a ICalendar duration string (see duration_value).

If a value is undefined or omitted, 1 is assumed:

    $ical->add( 'min' ); # add a minute

The result will be normalized. That is, the output time will have
meaningful values, rather than being 48:73 pm on the 34th of
hexadecember.

Adding months or years can be done via three different methods,
specified by the eom_mode parameter, which then applies to all
additions (or subtractions) of months or years following it in the
parameter list.

The default, eom_mode => 'wrap', means adding months or years that
result in days beyond the end of the new month will roll over into the
following month.  For instance, adding one year to Feb 29 will result
in Mar 1.

If you specify eom_mode => 'limit', the end of the month is never
crossed.  Thus, adding one year to Feb 29, 2000 will result in Feb 28,
2001.  However, adding three more years will result in Feb 28, 2004,
not Feb 29.

If you specify eom_mode => 'preserve', the same calculation is done as
for 'limit' except that if the original date is at the end of the
month the new date will also be.  For instance, adding one month to
Feb 29, 2000 will result in Mar 31, 2000.

All additions are performed in the order specified.  For instance,
with the default setting of eom_mode => 'wrap', adding one day and one
month to Feb 29 will result in Apr 1, while adding one month and one
day will result in Mar 30.

=cut

sub add {
    my $self = shift;
    carp "Date::ICal::add was called without an attribute arg" unless @_;
    ( $self->{julian}, $self->{julsec}) =
        _add($self->{julian}, $self->{julsec}, @_);
    return $self;
}

#}}}

# sub _add {{{

=begin internal

    Add (or subtract) to a date/time.  First two parameters are
    the jd and secs of the day.  For the rest, see the add method.
    Returns the adjusted jd and secs.

=end internal

=cut

# for each unit, specify what it changes by (0=day, 1=second, 2=month)
# and by what factor

%add_units = (year=>[2,12], month=>[2,1], week=>[0,7], day=>[0,1],
              hour=>[1,3600], min=>[1,60], sec=>[1,1], seconds=>[1,1]);

sub _add {
    my ($jd, $secs) = splice(@_, 0, 2);
    my $eom_mode = 0;
    my ($add, $unit, $count);

    # loop through unit=>count parameters
    while (($unit, $count) = splice(@_, 0, 2)) {

        if ($unit eq 'duration') { # add a duration string
            my %dur;
            @dur{'day','sec','month'} = duration_value($count);

            # pretend these were passed to us as e.g. month=>1, day=>1, sec=>1.
            # since months/years come first in the duration string, we
            # put them first.
            unshift @_, map $dur{$_} ? ($_,$dur{$_}) : (),
                            'month', 'day', 'sec';
            next;
        } elsif ($unit eq 'eom_mode') {
            if ($count eq 'wrap') { $eom_mode = 0 }
            elsif ($count eq 'limit') { $eom_mode = 1 }
            elsif ($count eq 'preserve') { $eom_mode = 2 }
            else { carp "Unrecognized eom_mode, $count, ignored" }
        } else {
            unless ($add = $add_units{$unit}) {
                carp "Unrecognized time unit, $unit, skipped";
                next;
            }

            $count = 1 if !defined $count; # count defaults to 1
            $count *= $add->[1]; # multiply by the factor for this unit

            if ($add->[0] == 0) { # add to days
                $jd += $count;
            } elsif ($add->[0] == 1) { # add to seconds
                $secs += $count;
            } else {            # add to months
                my ($y, $mo, $d);

                _normalize_seconds( $jd, $secs );
                if ($eom_mode == 2) { # sticky eom mode
                    # if it is the last day of the month, make it the 0th
                    # day of the following month (which then will normalize
                    # back to the last day of the new month).
                    ($y, $mo, $d) = jd2greg( $jd+1 );
                    --$d;
                } else {
                    ($y, $mo, $d) = jd2greg( $jd );
                }

                if ($eom_mode && $d > 28) { # limit day to last of new month
                    # find the jd of the last day of our target month
                    $jd = greg2jd( $y, $mo+$count+1, 0 );

                    # what day of the month is it? (discard year and month)
                    my $lastday = scalar jd2greg( $jd );

                    # if our original day was less than the last day,
                    # use that instead
                    $jd -= $lastday - $d if $lastday > $d;
                } else {
                    $jd = greg2jd( $y, $mo+$count, $d );
                }
            }
        }
    }

    _normalize_seconds( $jd, $secs );
}

#}}}

# sub add_overload {{{

=head2 add_overload

    $date = $date1 + $duration;

Where $duration is either a duration string, or a Date::ICal::Duration
object.

    $date += 'P2DT4H7M';

Adds a duration to a date object. Returns a new object, or, in the case
of +=, modifies the existing object.

=cut

sub add_overload {
    my $one = shift;
    my $two = shift;

    my $ret = $one->clone;

    if ( ref $two ) {
        $ret->add( duration => $two->as_ical );
    } else {
        $ret->add( duration => $two );
    }

    return $ret;
} # }}}

# sub _normalize_seconds {{{

=begin internal

    ($jd, $secs) = _normalize_seconds( $jd, $secs );

    Corrects seconds that have gone into following or previous day(s).
    Adjusts the passed days and seconds as well as returning them.

=end internal

=cut

sub _normalize_seconds {
    my $adj;

    if ($_[1] < 0) {
        $adj = int( ($_[1]-86399)/86400 );
    } else {
        $adj = int( $_[1]/86400 );
    }
    ($_[0] += $adj), ($_[1] -= $adj*86400);
}

#}}}

# sub duration_value {{{

=head2 duration_value

Given a duration string, this function returns the number of days,
seconds, and months represented by that duration. In that order. Seems
odd to me. This should be considered an internal function, and you
should expect the API to change in the very near future.

=cut

sub duration_value {
    my $str = shift;

    my @temp = $str =~ m{
            ([\+\-])?   (?# Sign)
            (P)     (?# 'P' for period? This is our magic character)
            (?:
                (?:(\d+)Y)? (?# Years)
                (?:(\d+)M)? (?# Months)
                (?:(\d+)W)? (?# Weeks)
                (?:(\d+)D)? (?# Days)
            )?
            (?:T        (?# Time prefix)
                (?:(\d+)H)? (?# Hours)
                (?:(\d+)M)? (?# Minutes)
                (?:(\d+)S)? (?# Seconds)
            )?
                }x;
    my ( $sign, $magic ) = @temp[ 0 .. 1 ];
    my ( $years, $months, $weeks, $days, $hours, $mins, $secs ) =
      map { defined($_) ? $_ : 0 } @temp[ 2 .. $#temp ];

    unless ( defined($magic) ) {
        carp "Invalid duration: $str";
        return undef;
    }
    $sign = ( ( defined($sign) && $sign eq '-' ) ? -1 : 1 );

    my $s = $sign * ( $secs + ( $mins * 60 ) + ( $hours * 3600 ) );
    my $d = $sign * ( $days + ( $weeks * 7 ) );
    my $m = $sign * ( $months + ( $years * 12 ) );
    return ( $d, $s, $m );
}

#}}}

# sub subtract {{{

=head2 subtract

  $duration = $date1 - $date2;

Subtract one Date::ICal object from another to give a duration - the
length of the interval between the two dates. The return value is a
Date::ICal::Duration object (qv) and allows you to get at each of the
individual components, or the entire duration string:

    $d = $date1 - $X;

Note that $X can be any of the following:

If $X is another Date::ICal object (or subclass thereof) then $d will be
a Date::ICal::Duration object.

    $week = $d->weeks; # how many weeks apart?
    $days = $d->as_days; # How many days apart?

If $X is a duration string, or a Date::ICal::Diration object, then $d
will be an object in the same class as $date1;

    $newdate = $date - $duration;

=cut

sub subtract {
    my ( $date1, $date2, $reversed ) = @_;
    my $dur;

    # If the order of the arguments was reversed, overload tells us
    # about it in the third argument.
    if ($reversed) {
        ( $date2, $date1 ) = ( $date1, $date2 );
    }

    if (ref $date1 && ref $date2) {
    # If $date1 is a Date::ICal object, and $date2 is a Duration object,
    # then we should subtract and get a date.
        if ((ref $date2) eq 'Date::ICal::Duration') {
            my $seconds = $date2->as_seconds;
            my $ret = $date1->clone;
            $ret->add( seconds => -1 * $seconds );
            return $ret;

        } else {
    # If $date2 is a Date::ICal object, or some class thereof, we should
    # subtract and get a duration

            my $days = $date1->{julian} - $date2->{julian};
            my $secs = $date1->{julsec} - $date2->{julsec};

            return Date::ICal::Duration->new(
              days    => $days,
              seconds => $secs
            );
        }
    } elsif ( ref $date1 &&
              ( $dur = Date::ICal::Duration->new( ical => $date2 ) )
            ) {
    # If $date1 is a Date::ICal object, and $date2 is a duration string,
    # we should subtract and get a date
        return $date1 - $dur; # Is that cheating?

    # Otherwise, return undef
    } else {
        warn "Invalid arguments. You can subtract a date from a date, or a duration from a date";
        return;
    }

} # }}}

# sub clone {{{

=head2 clone

    $copy = $date->clone;

Returns a replica of the date object, including all attributes.

=cut

sub clone {
    my $self = shift;
    my $class = ref $self;
    my %hash = %$self;
    my $new = \%hash;
    bless $new, $class;
    return $new;
} # }}}

# sub compare {{{

=head2 compare

    $cmp = $date1->compare($date2);

    @dates = sort {$a->compare($b)} @dates;

Compare two Date::ICal objects. Semantics are compatible with
sort; returns -1 if $a < $b, 0 if $a == $b, 1 if $a > $b.

=cut

sub compare {
    my ( $self, $otherdate ) = (@_);

    unless ( defined($otherdate) ) { return undef }

    # One or more days different

    if ( $self->{julian} < $otherdate->{julian} ) {
        return -1;
      } elsif ( $self->{julian} > $otherdate->{julian} )
    {
        return 1;

        # They are the same day
      } elsif ( $self->{julsec} < $otherdate->{julsec} )
    {
        return -1;
      } elsif ( $self->{julsec} > $otherdate->{julsec} )
    {
        return 1;
    }

    #    # if we got all this way and haven't yet returned, the units are equal.
    return 0;
}

#}}}

# internal stuff {{{

=begin internal

 @months = months($year);

Returns the Julian day at the end of a month, correct for that year.

=end internal

=cut

# precalculate these values at module load time so that we don't
# have to do it repeatedly during runtime.
#
BEGIN {

    #           +  31, 28, 31, 30,  31,  30,  31,  31,  30,  31,  30,  31
    @months = ( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 );
    @leapmonths = @months;

    for ( 2 .. 12 ) {
        $leapmonths[$_] = $months[$_] + 1;
    }
}

sub months {
    return Date::Leapyear::isleap(shift) ? @leapmonths : @months;
}

=begin internal

    time_as_seconds( $args{hour}, $args{min}, $args{sec} );

Returns the time of day as the number of seconds in the day.

=end internal

=cut

# }}}

# sub time_as_seconds {{{

sub time_as_seconds {
    my ( $hour, $min, $sec ) = @_;

    $hour ||= 0;
    $min ||= 0;
    $sec ||= 0;

    my $secs = $hour * 3600 + $min * 60 + $sec;
    return $secs;
} #}}}

# sub day {{{

=head2 day

    my $day = $date->day;

Returns the day of the month.

Day is in the range 1..31

=cut

sub day {
    my $self = shift;
    return ( jd2greg( $self->{julian} ) )[2];
} # }}}

# sub month {{{

=head2 month

    my $month = $date->month;

Returns the month of the year.

Month is returned as a number in the range 1..12

=cut

sub month {
    my $self = shift;
    return ( jd2greg( $self->{julian} ) )[1];
} # }}}

# sub mon {{{

sub mon { return month(@_); }

#}}}

# sub year {{{

=head2 year

    my $year = $date->year;

Returns the year.

=cut

sub year {
    my $self = shift;
    return ( jd2greg( $self->{julian} ) )[0];
} # }}}

# sub jd2greg {{{

=head2 jd2greg

    ($year, $month, $day) = jd2greg( $jd );

    Convert number of days on or after Jan 1, 1 CE (Gregorian) to
    gregorian year,month,day.

=cut

sub jd2greg {
    use integer;
    my $d = shift;
    my $yadj = 0;
    my ( $c, $y, $m );

    # add 306 days to make relative to Mar 1, 0; also adjust $d to be within
    # a range (1..2**28-1) where our calculations will work with 32bit ints
    if ( $d > 2**28 - 307 ) {

        # avoid overflow if $d close to maxint
        $yadj = ( $d - 146097 + 306 ) / 146097 + 1;
        $d -= $yadj * 146097 - 306;
      } elsif ( ( $d += 306 ) <= 0 )
    {
        $yadj =
          -( -$d / 146097 + 1 );    # avoid ambiguity in C division of negatives
        $d -= $yadj * 146097;
    }

    $c =
      ( $d * 4 - 1 ) / 146097;    # calc # of centuries $d is after 29 Feb of yr 0
    $d -= $c * 146097 / 4;    #     (4 centuries = 146097 days)
    $y = ( $d * 4 - 1 ) / 1461;    # calc number of years into the century,
    $d -= $y * 1461 / 4;    #     again March-based (4 yrs =~ 146[01] days)
    $m =
      ( $d * 12 + 1093 ) / 367;    # get the month (3..14 represent March through
    $d -= ( $m * 367 - 1094 ) / 12;    #     February of following year)
    $y += $c * 100 + $yadj * 400;    # get the real year, which is off by
    ++$y, $m -= 12 if $m > 12;         #     one if month is January or February
    return ( $y, $m, $d );
}    #}}}

# sub greg2jd {{{

=head2 greg2jd

    $jd = greg2jd( $year, $month, $day );

    Convert gregorian year,month,day to days on or after Jan 1, 1 CE
    (Gregorian).  Normalization is performed (e.g. month of 28 means
    April two years after given year) for month < 1 or > 12 or day < 1
    or > last day of month.

=cut

sub greg2jd {
    use integer;
    my ( $y, $m, $d ) = @_;
    my $adj;

    # make month in range 3..14 (treat Jan & Feb as months 13..14 of prev year)
    if ( $m <= 2 ) {
        $y -= ( $adj = ( 14 - $m ) / 12 );
        $m += 12 * $adj;
      } elsif ( $m > 14 )
    {
        $y += ( $adj = ( $m - 3 ) / 12 );
        $m -= 12 * $adj;
    }

    # make year positive (oh, for a use integer 'sane_div'!)
    if ( $y < 0 ) {
        $d -= 146097 * ( $adj = ( 399 - $y ) / 400 );
        $y += 400 * $adj;
    }

    # add: day of month, days of previous 0-11 month period that began w/March,
    # days of previous 0-399 year period that began w/March of a 400-multiple
    # year), days of any 400-year periods before that, and 306 days to adjust
    # from Mar 1, year 0-relative to Jan 1, year 1-relative (whew)

    $d += ( $m * 367 - 1094 ) / 12 + $y % 100 * 1461 / 4 +
      ( $y / 100 * 36524 + $y / 400 ) - 306;
}    # }}}

# sub days_this_year {{{

=head2 days_this_year

  $yday = Date::ICal::days_this_year($day, $month, $year);

Returns the number of days so far this year. Analogous to the yday
attribute of gmtime (or localtime) except that it works outside of the
epoch.

=cut

sub days_this_year {
    my ( $d, $m, $y ) = @_;
    my @mlist = &months($y);
    return $mlist[$m - 1] + $d - 1;
}    #}}}

# sub day_of_week {{{

=head2 day_of_week

    my $day_of_week = $date->day_of_week

Returns the day of week as 0..6 (0 is Sunday, 6 is Saturday).

=cut

sub day_of_week {
    my $self = shift;
    return $self->{julian} % 7;
}    #}}}

# sub hour {{{

=head2 hour

    my $hour = $date->hour

Returns the hour of the day.

Hour is in the range 0..23

=cut

sub hour {
    my $self = shift;
    return ( $self->parsetime )[2];
} # }}}

# sub min {{{

=head2 min

    my $min = $date->min;

Returns the minute.

Minute is in the range 0..59

=cut

sub min {
    my $self = shift;
    return ( $self->parsetime )[1];
}

sub minute { return min(@_); }

# }}}

# sub sec {{{

=head2 sec

    my $sec = $date->sec;

Returns the second.

Second is in the range 0..60. The value of 60 is (maybe) needed for
leap seconds. But I'm not sure if we're going to go there.

=cut

sub sec {
    my $self = shift;
    return ( $self->parsetime )[0];
}

sub second { return sec(@_); }

# }}}

# sub parsetime {{{

=begin internal

 ( $sec, $min, $hour ) = parsetime( $seconds );

Given the number of seconds so far today, returns the seconds,
minutes, and hours of the current time.

=end internal

=cut

sub parsetime {
    my $self = shift;
    my $time = $self->{julsec};

    my $hour = int( $time / 3600 );
    $time -= $hour * 3600;

    my $min = int( $time / 60 );
    $time -= $min * 60;

    return ( int($time), $min, $hour );
} # }}}

# sub julian/jd #{{{

=head2 julian

  my $jd = $date->jd;

Returns a listref, containing two elements. The date as a julian day,
and the time as the number of seconds since midnight. This should not
be thought of as a real julian day, because it's not. The module is
internally consistent, and that's enough.

This method really only is here for compatibility with previous
versions, as the jd method is now thrown over for plain hash references.

See the file INTERNALS for more information about this internal
format.

=cut

sub jd {
    my $self = shift;

    if ( my $jd = shift ) {
        ( $self->{julian}, $self->{julsec} ) = @$jd;
    }

    return [ $self->{julian}, $self->{julsec} ];
}

sub julian { return jd(@_) }

# INTERNAL ONLY: figures out what the UTC offset (in HHMM) is
# is for the current machine.
sub _calc_local_offset {

    use Time::Local;
    my @t = gmtime;

    my $local = timelocal(@t);
    my $gm    = timegm(@t);

    my $secdiff = $gm - $local;
    return offset_from_seconds($secdiff);
}

#}}}

1;

# More docs {{{

=head1 TODO

=over 4

=item - add gmtime and localtime methods, perhaps?

=item - Fix the INTERNALS file so that it actually reflects reality

=back

=head1 INTERNALS

Please see the file INTERNALS for discussion on the internals.

=head1 AUTHOR

Rich Bowen (DrBacchus) [e-mail]

And the rest of the Reefknot team. See the source for a full
list of patch contributors and version-by-version notes.

=head1 LICENSE AND COPYRIGHT

© 2001-2022 Rich Bowen

© 2022-2023 Michal Josef Špaček

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

[e-mail] mailing list

L

Time::Local

Net::ICal

=cut

#}}}