1package Date::ICal::Duration;
2
3use strict;
4use Carp;
5
6use vars qw($VERSION );
7$VERSION = (qw'$Revision: 1.61 $')[1];
8
9# Documentation {{{
10
11=head1 NAME
12
13Date::ICal::Duration - durations in iCalendar format, for math purposes.
14
15=head1 VERSION
16
17$Revision: 1.61 $
18
19=head1 SYNOPSIS
20
21    use Date::ICal::Duration;
22
23    $d = Date::ICal::Duration->new( ical => '-P1W3DT2H3M45S' );
24
25    $d = Date::ICal::Duration->new( weeks => 1,
26                                    days => 1,
27                                    hours => 6,
28                                    minutes => 15,
29                                    seconds => 45);
30
31    # a one hour duration, without other components
32    $d = Date::ICal::Duration->new( seconds => "3600");
33
34    # Read-only accessors:
35    $d->weeks;
36    $d->days;
37    $d->hours;
38    $d->minutes;
39    $d->seconds;
40    $d->sign;
41
42    # TODO: Resolve sign() discussion from rk-devel and update synopsis.
43
44    $d->as_seconds ();   # returns just seconds
45    $d->as_elements ();  # returns a hash of elements, like the accessors above
46    $d->as_ical();       # returns an iCalendar duration string
47
48=head1 DESCRIPTION
49
50This is a trivial class for representing duration objects, for doing math
51in Date::ICal
52
53=head1 AUTHOR
54
55Rich Bowen, and the Reefknot team. Alas, Reefknot is no more. See
56http://datetime.perl.org/ for more modern modules.
57
58Last touched by $Author: rbowen $
59
60=head1 METHODS
61
62Date::ICal::Duration has the following methods available:
63
64=head2 new
65
66A new Date::ICal::Duration object can be created with an iCalendar string :
67
68    my $ical = Date::ICal::Duration->new ( ical => 'P3W2D' );
69    # 3 weeks, 2 days, positive direction
70    my $ical = Date::ICal::Duration->new ( ical => '-P6H3M30S' );
71    # 6 hours, 3 minutes, 30 seconds, negative direction
72
73Or with a number of seconds:
74
75    my $ical = Date::ICal::Duration->new ( seconds => "3600" );
76    # one hour positive
77
78Or, better still, create it with components
79
80    my $date = Date::ICal::Duration->new (
81                           weeks => 6,
82                           days => 2,
83                           hours => 7,
84                           minutes => 15,
85                           seconds => 47,
86                           sign => "+"
87                           );
88
89The sign defaults to "+", but "+" and "-" are legal values.
90
91=cut
92
93#}}}
94
95#{{{ sub new
96
97sub new {
98    my ($class, %args) = @_;
99    my $verified = {};
100    my $self = {};
101    bless $self, $class;
102
103    my $seconds_only = 1;    # keep track of whether we were given length in seconds only
104    $seconds_only = 0 unless (defined $args{'seconds'});
105
106    # If one of the attributes is negative, then they all must be
107    # negative. Otherwise, we're not sure what this means.
108    foreach (qw(hours minutes seconds days weeks)) {
109        if (defined($args{$_}) )   {
110            # make sure this argument is all digits, optional - sign
111            if ($args{$_} =~ m/-?[0-9]+$/) {
112                if ($args{$_} < 0) {
113                    $args{sign} = '-';
114                    $args{$_} = abs($args{$_});
115                }
116                $verified->{$_} = $args{$_};
117                unless ($_ eq 'seconds') {
118                    $seconds_only = 0;
119                }
120            } else {
121                carp ("Parameter $_ contains non-numeric value " . $args{$_} . "\n");
122            }
123        }
124    }
125
126    if (defined ($args{sign}) ) {
127
128        # make sure this argument + or -
129        if ($args{sign} =~ m/[+-]/) {
130            # if so, assign it
131            $self->{sign} = ($args{sign} eq "+") ? 1 : -1;
132            $verified->{sign} = ($args{sign} eq "+") ? '+' : '-';
133        } else {
134            carp ("Parameter sign contains a value other than + or - : "
135                . $args{sign} . "\n");
136        }
137
138    }
139
140    # If a number is given, convert it to hours, minutes, and seconds,
141    # but *don't* extract days -- we want it to represent an absolute
142    # amount of time, regardless of timezone
143    if ($seconds_only) { # if we were given an integer time_t
144        $self->_set_from_seconds($args{'seconds'});
145    } elsif (defined ($args{'ical'}) ) {
146        # A standard duration string
147        #warn "setting from ical\n";
148        $self->_set_from_ical($args{'ical'});
149    } elsif (not $seconds_only) {
150        #warn "setting from components";
151        #use Data::Dumper; warn Dumper $verified;
152        $self->_set_from_components($verified);
153    }
154
155    return undef unless %args;
156
157    return $self;
158}
159
160#}}}
161
162# Accessors {{{
163
164=head2 sign, weeks, days, hours, minutes, seconds
165
166Read-only accessors for the elements of the object.
167
168=cut 
169
170#}}}
171
172# {{{ sub sign
173
174sub sign {
175    my ($self) = @_;
176    return $self->{sign};
177}
178
179#}}}
180
181# {{{ sub weeks
182
183sub weeks {
184    my ($self) = @_;
185    my $w = ${$self->_wd}[0];
186    return unless $w;
187    return $self->{sign} * $w;
188}
189
190#}}}
191
192# {{{ sub days
193
194sub days {
195    my ($self) = @_;
196    my $d = ${$self->_wd}[1];
197    return unless $d;
198    return  $self->{sign} * $d;
199
200} #}}}
201
202#{{{ sub hours
203
204sub hours {
205    my ($self) = @_;
206    my $h = ${$self->_hms}[0];
207    return unless $h;
208    return $self->{sign} * $h;
209}
210
211#}}}
212
213# {{{ sub minutes
214
215sub minutes {
216    my ($self) = @_;
217    my $m = ${$self->_hms}[1];
218    return unless $m;
219    return $self->{sign} * $m;
220}
221
222#}}}
223
224# {{{ sub seconds
225
226sub seconds {
227    my ($self) = @_;
228    my $s = ${$self->_hms}[2];
229    return unless $s;
230    return $self->{sign} * $s;
231}
232
233#}}}
234
235# sub as_seconds {{{
236
237=head2 as_seconds
238
239Returns the duration in raw seconds.
240
241WARNING -- this folds in the number of days, assuming that they are always 86400
242seconds long (which is not true twice a year in areas that honor daylight
243savings time).  If you're using this for date arithmetic, consider using the
244I<add()> method from a L<Date::ICal> object, as this will behave better.
245Otherwise, you might experience some error when working with times that are
246specified in a time zone that observes daylight savings time.
247
248
249=cut 
250
251sub as_seconds {
252    my ($self) = @_;
253
254    my $nsecs = $self->{nsecs} || 0;
255    my $ndays = $self->{ndays} || 0;
256    my $sign  = $self->{sign}  || 1;
257    return $sign*($nsecs+($ndays*24*60*60));
258}
259
260#}}}
261
262# sub as_days {{{
263
264=head2 as_days
265
266    $days = $duration->as_days;
267
268Returns the duration as a number of days. Not to be confused with the
269C<days> method, this method returns the total number of days, rather
270than mod'ing out the complete weeks. Thus, if we have a duration of 33
271days, C<weeks> will return 4, C<days> will return 5, but C<as_days> will
272return 33.
273
274Note that this is a lazy convenience function which is just weeks*7 +
275days.
276
277=cut
278
279sub as_days {
280    my ($self) = @_;
281    my $wd = $self->_wd;
282    return $self->{sign} * ( $wd->[0]*7 + $wd->[1] );
283}# }}}
284
285#{{{ sub as_ical
286
287=head2 as_ical
288
289Return the duration in an iCalendar format value string (e.g., "PT2H0M0S")
290
291=cut 
292
293sub as_ical {
294    my ($self) = @_;
295
296    my $tpart = '';
297
298    if (my $ar_hms = $self->_hms) {
299        $tpart = sprintf('T%dH%dM%dS', @$ar_hms);
300    }
301
302    my $ar_wd = $self->_wd();
303
304    my $dpart = '';
305    if (defined $ar_wd) {
306        my ($weeks, $days) = @$ar_wd;
307        if ($weeks && $days) {
308            $dpart = sprintf('%dW%dD', $weeks, $days);
309        } elsif ($weeks) {   # (if days = 0)
310            $dpart = sprintf('%dW', $weeks);
311        } else {
312            $dpart = sprintf('%dD', $days);
313        }
314    }
315
316    # put a sign in the return value if necessary
317    my $value = join('', (($self->{sign} < 0) ? '-' : ''),
318                     'P', $dpart, $tpart);
319
320    # remove any zero components from the time string (-P10D0H -> -P10D)
321    $value =~ s/(?<=[^\d])0[WDHMS]//g;
322
323    # return either the time value or PT0S (if the time value is zero).
324    return (($value !~ /PT?$/) ? $value : 'PT0S');
325}
326
327#}}}
328
329#{{{ sub as_elements
330
331=head2 as_elements
332
333Returns the duration as a hashref of elements.
334
335=cut 
336
337sub as_elements {
338    my ($self) = @_;
339
340    # get values for all the elements
341    my $wd = $self->_wd;
342    my $hms = $self->_hms;
343
344    my $return = {
345        sign => $self->{sign},
346        weeks => ${$wd}[0],
347        days => ${$wd}[1],
348        hours => ${$hms}[0],
349        minutes => ${$hms}[1],
350        seconds => ${$hms}[2],
351    };
352    return $return;
353}
354
355#}}}
356
357# INTERNALS {{{
358
359=head1 INTERNALS
360
361head2 GENERAL MODEL
362
363Internally, we store 3 data values: a number of days, a number of seconds (anything
364shorter than a day), and a sign (1 or -1). We are assuming that a day is 24 hours for
365purposes of this module; yes, we know that's not completely accurate because of
366daylight-savings-time switchovers, but it's mostly correct. Suggestions are welcome.
367
368NOTE: The methods below SHOULD NOT be relied on to stay the same in future versions.
369
370=head2 _set_from_ical ($self, $duration_string)
371
372Converts a RFC2445 DURATION format string to the internal storage format.
373
374=cut
375
376#}}}
377
378# sub _set_from_ical (internal) {{{
379
380sub _set_from_ical {
381    my ($self, $str) = @_;
382
383    my $parsed_values = _parse_ical_string($str);
384
385    return $self->_set_from_components($parsed_values);
386} # }}}
387
388# sub _parse_ical_string (internal) {{{
389
390=head2 _parse_ical_string ($string)
391
392Regular expression for parsing iCalendar into usable values.
393
394=cut
395
396sub _parse_ical_string {
397    my ($str) = @_;
398
399    # RFC 2445 section 4.3.6
400    #
401    # dur-value  = (["+"] / "-") "P" (dur-date / dur-time / dur-week)
402    # dur-date   = dur-day [dur-time]
403    # dur-time   = "T" (dur-hour / dur-minute / dur-second)
404    # dur-week   = 1*DIGIT "W"
405    # dur-hour   = 1*DIGIT "H" [dur-minute]
406    # dur-minute = 1*DIGIT "M" [dur-second]
407    # dur-second = 1*DIGIT "S"
408    # dur-day    = 1*DIGIT "D"
409
410    my ($sign_str, $magic, $weeks, $days, $hours, $minutes, $seconds) =
411        $str =~ m{
412            ([\+\-])?   (?# Sign)
413            (P)     (?# 'P' for period? This is our magic character)
414            (?:
415                (?:(\d+)W)? (?# Weeks)
416                (?:(\d+)D)? (?# Days)
417            )?
418            (?:T        (?# Time prefix)
419                (?:(\d+)H)? (?# Hours)
420                (?:(\d+)M)? (?# Minutes)
421                (?:(\d+)S)? (?# Seconds)
422            )?
423        }x;
424
425    if (!defined($magic)) {
426        carp "Invalid duration: $str";
427        return undef;
428    }
429
430    # make sure the sign gets set, and turn it into an integer multiplier
431    $sign_str ||= "+";
432    my $sign = ($sign_str eq "-") ? -1 : 1;
433
434    my $return = {};
435    $return->{'weeks'} = $weeks;
436    $return->{'days'} = $days;
437    $return->{'hours'} = $hours;
438    $return->{'minutes'} = $minutes;
439    $return->{'seconds'} = $seconds;
440    $return->{'sign'} = $sign;
441
442    return $return;
443} # }}}
444
445# sub _set_from_components (internal) {{{
446
447=head2 _set_from_components ($self, $hashref)
448
449Converts from a hashref to the internal storage format.
450The hashref can contain elements "sign", "weeks", "days", "hours", "minutes", "seconds".
451
452=cut
453
454sub _set_from_components {
455    my ($self, $args) = @_;
456
457    # Set up some easier-to-read variables
458    my ($sign, $weeks, $days, $hours, $minutes, $seconds);
459    $sign = $args->{'sign'};
460    $weeks = $args->{'weeks'};
461    $days = $args->{'days'};
462    $hours = $args->{'hours'};
463    $minutes = $args->{'minutes'};
464    $seconds = $args->{'seconds'};
465
466    $self->{sign} = (defined($sign) && $sign eq '-') ? -1 : 1;
467
468    if (defined($weeks) or defined($days)) {
469        $self->_wd([$weeks || 0, $days || 0]);
470    }
471
472    if (defined($hours) || defined($minutes) || defined($seconds)) {
473        $self->_hms([$hours || 0, $minutes || 0, $seconds || 0]);
474    }
475
476    return $self;
477} # }}}
478
479# sub _set_from_ical (internal) {{{
480
481=head2 _set_from_ical ($self, $num_seconds)
482
483Sets internal data storage properly if we were only given seconds as a parameter.
484
485=cut
486
487sub _set_from_seconds {
488    my ($self, $seconds) = @_;
489
490    $self->{sign} = (($seconds < 0) ? -1 : 1);
491    # find the number of days, if any
492    my $ndays = int ($seconds / (24*60*60));
493    # now, how many hours/minutes/seconds are there, after
494    # days are taken out?
495    my $nsecs = $seconds % (24*60*60);
496    $self->{ndays} = abs($ndays);
497    $self->{nsecs} = abs($nsecs);
498
499
500    return $self;
501} # }}}
502
503# sub _hms (internal) {{{
504
505=head2 $self->_hms();
506
507Return an arrayref to hours, minutes, and second components, or undef
508if nsecs is undefined.  If given an arrayref, computes the new nsecs value
509for the duration.
510
511=cut 
512
513sub _hms {
514    my ($self, $hms_arrayref) = @_;
515
516    if (defined($hms_arrayref)) {
517        my $new_sec_value = $hms_arrayref->[0]*3600 +
518                            $hms_arrayref->[1]*60   + $hms_arrayref->[2];
519        $self->{nsecs} = ($new_sec_value);
520    }
521
522    my $nsecs = $self->{nsecs};
523    if (defined($nsecs)) {
524        my $hours = int($nsecs/3600);
525        my $minutes  = int(($nsecs-$hours*3600)/60);
526        my $seconds  = $nsecs % 60;
527        return [ $hours, $minutes, $seconds ];
528    } else {
529        print "returning undef\n";
530        return undef;
531    }
532} # }}}
533
534# sub _wd (internal) {{{
535
536=head2 $self->_wd()
537
538Return an arrayref to weeks and day components, or undef if ndays
539is undefined.  If Given an arrayref, computs the new ndays value
540for the duration.
541
542=cut 
543
544sub _wd  {
545    my ($self, $wd_arrayref) = @_;
546
547    #print "entering _wd\n";
548
549    if (defined($wd_arrayref)) {
550
551        my $new_ndays = $wd_arrayref->[0]*7 + $wd_arrayref->[1];
552        $self->{ndays} = $new_ndays;
553    }
554
555    #use Data::Dumper; print Dumper $self->{ndays};
556
557    if (defined(my $ndays= $self->{ndays})) {
558        my $weeks = int($ndays/7);
559        my $days  = $ndays % 7;
560        return [ $weeks, $days ];
561    } else {
562        return undef;
563    }
564} # }}}
565
5661;
567