Date::ICal::Duration - durations in iCalendar format, for math purposes.

    use Date::ICal::Duration;

    $d = Date::ICal::Duration->new( ical => '-P1W3DT2H3M45S' );

    $d = Date::ICal::Duration->new( weeks => 1, 
                                    days => 1,
                                    hours => 6,
                                    minutes => 15,
                                    seconds => 45); 

    # a one hour duration, without other components
    $d = Date::ICal::Duration->new( seconds => "3600"); 

    # Read-only accessors:
    $d->weeks;
    $d->days;
    $d->hours;
    $d->minutes;
    $d->seconds;
    $d->sign;

    # TODO: Resolve sign() discussion from rk-devel and update synopsis.

    $d->as_seconds ();   # returns just seconds
    $d->as_elements ();  # returns a hash of elements, like the accessors above
    $d->as_ical();       # returns an iCalendar duration string

    my $ical = Date::ICal::Duration->new ( ical => 'P3W2D' );
    # 3 weeks, 2 days, positive direction
    my $ical = Date::ICal::Duration->new ( ical => '-P6H3M30S' );
    # 6 hours, 3 minutes, 30 seconds, negative direction

    my $ical = Date::ICal::Duration->new ( seconds => "3600" );
    # one hour positive

    my $date = Date::ICal::Duration->new ( 
                           weeks => 6, 
                           days => 2, 
                           hours => 7,
                           minutes => 15,
                           seconds => 47,
                           sign => "+"
                           );

    $days = $duration->as_days;

package Date::ICal::Duration;

use strict;
use Carp;

use vars qw($VERSION );
$VERSION = (qw'$Revision: 1.61 $')[1];

# Documentation {{{

#}}}

#{{{ sub new

sub new {
    my ($class, %args) = @_;
    my $verified = {};
    my $self = {};
    bless $self, $class;

    my $seconds_only = 1;    # keep track of whether we were given length in seconds only
    $seconds_only = 0 unless (defined $args{'seconds'}); 

    # If one of the attributes is negative, then they all must be
    # negative. Otherwise, we're not sure what this means.
    foreach (qw(hours minutes seconds days weeks)) {
        if (defined($args{$_}) )   {
            # make sure this argument is all digits, optional - sign
            if ($args{$_} =~ m/-?[0-9]+$/) { 
                if ($args{$_} < 0) {
                    $args{sign} = '-';
                    $args{$_} = abs($args{$_});
                }
                $verified->{$_} = $args{$_};
                unless ($_ eq 'seconds') {
                    $seconds_only = 0;
                }
            } else {
                carp ("Parameter $_ contains non-numeric value " . $args{$_} . "\n");
            }
        }
    }

    if (defined ($args{sign}) ) {

        # make sure this argument + or -
        if ($args{sign} =~ m/[+-]/) {
            # if so, assign it
            $self->{sign} = ($args{sign} eq "+") ? 1 : -1;
            $verified->{sign} = ($args{sign} eq "+") ? '+' : '-';
        } else {
            carp ("Parameter sign contains a value other than + or - : "
                . $args{sign} . "\n");
        }
        
    }

    # If a number is given, convert it to hours, minutes, and seconds,
    # but *don't* extract days -- we want it to represent an absolute
    # amount of time, regardless of timezone
    if ($seconds_only) { # if we were given an integer time_t
        $self->_set_from_seconds($args{'seconds'});
    } elsif (defined ($args{'ical'}) ) {   
        # A standard duration string
        #warn "setting from ical\n";
        $self->_set_from_ical($args{'ical'});
    } elsif (not $seconds_only) {
        #warn "setting from components";
        #use Data::Dumper; warn Dumper $verified;
        $self->_set_from_components($verified);
    }
    
    return undef unless %args;
   
    return $self;
}

#}}}

# Accessors {{{

#}}}

# {{{ sub sign 

sub sign {
    my ($self) = @_;
    return $self->{sign};
}

#}}}

# {{{ sub weeks 

sub weeks {
    my ($self) = @_;
    my $w = ${$self->_wd}[0];
    return unless $w;
    return $self->{sign} * $w;
}

#}}}

# {{{ sub days 

sub days {
    my ($self) = @_;
    my $d = ${$self->_wd}[1];
    return unless $d;
    return  $self->{sign} * $d;

} #}}}

#{{{ sub hours 

sub hours {
    my ($self) = @_;
    my $h = ${$self->_hms}[0];
    return unless $h;
    return $self->{sign} * $h;
}

#}}}

# {{{ sub minutes 

sub minutes {
    my ($self) = @_;
    my $m = ${$self->_hms}[1];
    return unless $m;
    return $self->{sign} * $m;
}

#}}}

# {{{ sub seconds 

sub seconds {
    my ($self) = @_;
    my $s = ${$self->_hms}[2];
    return unless $s;
    return $self->{sign} * $s;
}

#}}}

# sub as_seconds {{{

sub as_seconds {
    my ($self) = @_;

    my $nsecs = $self->{nsecs} || 0;
    my $ndays = $self->{ndays} || 0;
    my $sign  = $self->{sign}  || 1;
    return $sign*($nsecs+($ndays*24*60*60));
}

#}}}

# sub as_days {{{

sub as_days {
    my ($self) = @_;
    my $wd = $self->_wd;
    return $self->{sign} * ( $wd->[0]*7 + $wd->[1] );
}# }}}

#{{{ sub as_ical 

sub as_ical {
    my ($self) = @_;

    my $tpart = '';

    if (my $ar_hms = $self->_hms) {
        $tpart = sprintf('T%dH%dM%dS', @$ar_hms);
    }

    my $ar_wd = $self->_wd();
    
    my $dpart = '';
    if (defined $ar_wd) {
        my ($weeks, $days) = @$ar_wd;
        if ($weeks && $days) {
            $dpart = sprintf('%dW%dD', $weeks, $days);
        } elsif ($weeks) {   # (if days = 0)
            $dpart = sprintf('%dW', $weeks);
        } else {
            $dpart = sprintf('%dD', $days);
        }
    }

    # put a sign in the return value if necessary
    my $value = join('', (($self->{sign} < 0) ? '-' : ''),
                     'P', $dpart, $tpart);

    # remove any zero components from the time string (-P10D0H -> -P10D)
    $value =~ s/(?<=[^\d])0[WDHMS]//g;

    # return either the time value or PT0S (if the time value is zero).
    return (($value !~ /PT?$/) ? $value : 'PT0S');
}

#}}}

#{{{ sub as_elements

sub as_elements {
    my ($self) = @_;
   
    # get values for all the elements
    my $wd = $self->_wd;
    my $hms = $self->_hms;
   
    my $return = {
        sign => $self->{sign}, 
        weeks => ${$wd}[0],
        days => ${$wd}[1],
        hours => ${$hms}[0],
        minutes => ${$hms}[1],
        seconds => ${$hms}[2],
    };
    return $return;
}

#}}}

# INTERNALS {{{

#}}}

# sub _set_from_ical (internal) {{{

sub _set_from_ical {
    my ($self, $str) = @_;

    my $parsed_values = _parse_ical_string($str);
    
    return $self->_set_from_components($parsed_values);
} # }}}

# sub _parse_ical_string (internal) {{{

sub _parse_ical_string {
    my ($str) = @_;
    
    # RFC 2445 section 4.3.6
    #
    # dur-value  = (["+"] / "-") "P" (dur-date / dur-time / dur-week)
    # dur-date   = dur-day [dur-time]
    # dur-time   = "T" (dur-hour / dur-minute / dur-second)
    # dur-week   = 1*DIGIT "W"
    # dur-hour   = 1*DIGIT "H" [dur-minute]
    # dur-minute = 1*DIGIT "M" [dur-second]
    # dur-second = 1*DIGIT "S"
    # dur-day    = 1*DIGIT "D"

    my ($sign_str, $magic, $weeks, $days, $hours, $minutes, $seconds) =
        $str =~ m{
                        ([\+\-])?   (?# Sign)
                        (P)     (?# 'P' for period? This is our magic character)
                        (?:
                                (?:(\d+)W)? (?# Weeks)
                                (?:(\d+)D)? (?# Days)
                        )?
                        (?:T        (?# Time prefix)
                                (?:(\d+)H)? (?# Hours)
                                (?:(\d+)M)? (?# Minutes)
                                (?:(\d+)S)? (?# Seconds)
                        )?
                }x;

    if (!defined($magic)) {
        carp "Invalid duration: $str";
        return undef;
    }

    # make sure the sign gets set, and turn it into an integer multiplier
    $sign_str ||= "+";
    my $sign = ($sign_str eq "-") ? -1 : 1;
    
    my $return = {};
    $return->{'weeks'} = $weeks;
    $return->{'days'} = $days;
    $return->{'hours'} = $hours;
    $return->{'minutes'} = $minutes;
    $return->{'seconds'} = $seconds;
    $return->{'sign'} = $sign;

    return $return;
} # }}}

# sub _set_from_components (internal) {{{

sub _set_from_components {
    my ($self, $args) = @_;

    # Set up some easier-to-read variables
    my ($sign, $weeks, $days, $hours, $minutes, $seconds);
    $sign = $args->{'sign'};
    $weeks = $args->{'weeks'};
    $days = $args->{'days'};
    $hours = $args->{'hours'};
    $minutes = $args->{'minutes'};
    $seconds = $args->{'seconds'};
    
    $self->{sign} = (defined($sign) && $sign eq '-') ? -1 : 1;

    if (defined($weeks) or defined($days)) {
        $self->_wd([$weeks || 0, $days || 0]);
    }

    if (defined($hours) || defined($minutes) || defined($seconds)) {
        $self->_hms([$hours || 0, $minutes || 0, $seconds || 0]);
    }

    return $self;
} # }}}

# sub _set_from_ical (internal) {{{

sub _set_from_seconds {
    my ($self, $seconds) = @_;
            
    $self->{sign} = (($seconds < 0) ? -1 : 1);
    # find the number of days, if any
    my $ndays = int ($seconds / (24*60*60));
    # now, how many hours/minutes/seconds are there, after
    # days are taken out?
    my $nsecs = $seconds % (24*60*60);
    $self->{ndays} = abs($ndays);
    $self->{nsecs} = abs($nsecs);


    return $self;
} # }}}

# sub _hms (internal) {{{

sub _hms {
    my ($self, $hms_arrayref) = @_;

    if (defined($hms_arrayref)) {
        my $new_sec_value = $hms_arrayref->[0]*3600 +
                            $hms_arrayref->[1]*60   + $hms_arrayref->[2];
        $self->{nsecs} = ($new_sec_value);
    } 

    my $nsecs = $self->{nsecs};
    if (defined($nsecs)) {
        my $hours = int($nsecs/3600);
        my $minutes  = int(($nsecs-$hours*3600)/60);
        my $seconds  = $nsecs % 60;
        return [ $hours, $minutes, $seconds ];
    } else {
        print "returning undef\n";
        return undef;
    }
} # }}}

# sub _wd (internal) {{{

sub _wd  {
    my ($self, $wd_arrayref) = @_;

    #print "entering _wd\n";
    
    if (defined($wd_arrayref)) {
        
        my $new_ndays = $wd_arrayref->[0]*7 + $wd_arrayref->[1];
        $self->{ndays} = $new_ndays;
    }
    
    #use Data::Dumper; print Dumper $self->{ndays};
    
    if (defined(my $ndays= $self->{ndays})) {
        my $weeks = int($ndays/7);
        my $days  = $ndays % 7;
        return [ $weeks, $days ];
    } else {
        return undef;
    }
} # }}}

1;