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