1#!/usr/bin/perl 2package Date::Handler::Delta; 3 4use strict; 5use Carp; 6use Data::Dumper; 7use vars qw(@ISA $VERSION); 8$VERSION = '1.0'; 9 10use POSIX qw(floor strftime mktime); 11 12use overload ( 13 '""' => 'AsScalar', 14 '0+' => 'AsNumber', 15 'neg' => 'Neg', 16 '+' => 'Add', 17 '-' => 'Sub', 18 '*' => 'Mul', 19 '/' => 'Div', 20 '<=>' => 'Cmp', 21 '++' => 'Incr', 22 '%' => sub { croak "Impossible to modulo a Date::Handler::Delta"; }, 23 '**' => sub { croak "Trying to obtain square virtual minutes out of a virtual delta boy ?"; }, 24 fallback => 1, 25); 26 27 28sub new 29{ 30 my ($classname, $delta) = @_; 31 32 my $self = {}; 33 bless $self, $classname; 34 35 croak "No args to new()" if not defined $delta; 36 37 if(ref($delta) =~ /ARRAY/) 38 { 39 my $delta_array = $self->DeltaFromArray($delta); 40 $self->{months} = $delta_array->[0]; 41 $self->{seconds} = $delta_array->[1]; 42 } 43 elsif(ref($delta) =~ /HASH/) 44 { 45 my $delta_array = $self->DeltaFromArray([ 46 $delta->{years}, 47 $delta->{months}, 48 $delta->{days}, 49 $delta->{hours}, 50 $delta->{minutes}, 51 $delta->{seconds}, 52 ]); 53 $self->{months} = $delta_array->[0]; 54 $self->{seconds} = $delta_array->[1]; 55 56 } 57 elsif(!ref($delta)) 58 { 59 $self->{months} = 0; 60 $self->{seconds} = $delta; 61 } 62 else 63 { 64 croak "Arguments to new in unknown format."; 65 } 66 67 croak "Could not parse delta" if !defined $self->{months} && !defined $self->{seconds}; 68 69 return $self; 70} 71 72 73 74#Accessors (Might want to optimised some of those) 75sub Months { return shift->{months}; } 76sub Seconds { return shift->{seconds}; } 77 78 79#Oveload methods. 80sub AsScalar { return sprintf("%d:%d", @{shift()->AsArray()}); } 81sub AsNumber { return sprintf("%d.%d",@{shift()->AsArray()}); } 82 83sub AsArray 84{ 85 my $self = shift; 86 return [$self->Months()||0,$self->Seconds()||0]; 87} 88 89sub AsHash 90{ 91 my $self = shift; 92 93 return { 94 month => $self->Months(), 95 seconds => $self->Seconds(), 96 }; 97} 98 99 100sub Add 101{ 102 my ($self, $delta) = @_; 103 104 105 my $self_array = $self->AsArray(); 106 107 if(!ref($delta)) 108 { 109 $self_array->[1] += $delta; 110 } 111 elsif($delta->isa('Date::Handler::Delta')) 112 { 113 $self_array->[0] += $delta->Months(); 114 $self_array->[1] += $delta->Seconds(); 115 } 116 elsif($delta->isa('Date::Handler')) 117 { 118 return $delta->Add($self); 119 } 120 else 121 { 122 $self_array->[1] += $delta; 123 } 124 125 return ref($self)->new([0, $self_array->[0], 0,0,0,$self_array->[1]]); 126} 127 128sub Sub 129{ 130 my ($self, $delta) = @_; 131 132 if(ref($delta) && $delta->isa('Date::Handler')) 133 { 134 croak "Cannot substract a date from a Delta."; 135 } 136 137 return $self->Add(-$delta); 138} 139sub Cmp 140{ 141 my ($self, $delta) = @_; 142 143 croak "Cannot compare a Delta with something else than another Delta" if(!ref($delta)); 144 145 if($delta->isa('Date::Handler::Delta')) 146 { 147 my $self_time = 24*60*60*(30*$self->Months())+$self->Seconds(); 148 my $delta_time = 24*60*60*(30*$delta->Months())+$delta->Seconds(); 149 150 return $self_time <=> $delta_time; 151 } 152 else 153 { 154 croak "Cannot compare a Delta with something else than another Delta"; 155 } 156 157} 158 159sub Mul 160{ 161 my ($self, $delta) = @_; 162 163 if(!ref($delta)) 164 { 165 my $months = $self->Months() * $delta; 166 my $seconds = $self->Seconds() * $delta; 167 168 return ref($self)->new([0, $months,0,0,0,$seconds]); 169 } 170 elsif($delta->isa('Date::Handler::Delta')) 171 { 172 croak "Cannot obtain square minutes from Delta multiplication"; 173 } 174 elsif($delta->isa('Date::Handler')) 175 { 176 croak "Cannot Multiply a date with a delta."; 177 } 178 else 179 { 180 my $months = $self->Months() * $delta; 181 my $seconds = $self->Seconds() * $delta; 182 183 return ref($self)->new([0, $months,0,0,0,$seconds]); 184 } 185 186} 187sub Div 188{ 189 my ($self, $delta) = @_; 190 191 if(!ref($delta)) 192 { 193 my $months = floor($self->Months() / $delta); 194 my $seconds = floor($self->Seconds() / $delta); 195 196 return ref($self)->new([0, $months,0,0,0,$seconds]); 197 } 198 elsif($delta->isa('Date::Handler::Delta')) 199 { 200 croak "Cannot divide a delta expressed in months and seconds." if($self->Months() && $self->Seconds()); 201 croak "Cannot divide a delta expressed in months and seconds." if($delta->Months() && $delta->Seconds()); 202 203 croak "You can only divide by a delta expressed in the same unit." if($self->Months() && $delta->Seconds()); 204 croak "You can only divide by a delta expressed in the same unit." if($self->Seconds() && $delta->Months()); 205 206 if($self->Months()) 207 { 208 my $recurrence = $self->Months() / $delta->Months(); 209 return $recurrence; 210 } 211 else 212 { 213 if($delta->Seconds()) 214 { 215 my $recurrence = $self->Seconds() / $delta->Seconds(); 216 return $recurrence; 217 } 218 else 219 { 220 return (0 / $delta->Months()); 221 } 222 } 223 } 224 elsif($delta->isa('Date::Handler')) 225 { 226 croak "Cannot divide a date and a delta."; 227 } 228 else 229 { 230 my $months = floor($self->Months() / $delta); 231 my $seconds = floor($self->Seconds() / $delta); 232 233 return ref($self)->new([0, $months,0,0,0,$seconds]); 234 } 235} 236 237sub ApproximateInSeconds 238{ 239 my $self = shift; 240 my $direction = shift; 241 242 if($direction eq 'over') 243 { 244 my $years = floor($self->Months() / 12); 245 return $self->Seconds() + (24 * 60 * 60 * (($years * 366) + ($self->Months() % 12) * 31)); 246 } 247 elsif($direction eq 'under') 248 { 249 my $years = floor($self->Months() / 12); 250 my $months = $self->Months() % 12; 251 my $months_as_days = 0; 252 253 if($months) 254 { 255 $months--; 256 $months_as_days += 28; 257 $months_as_days += $months * 30; 258 } 259 260 return $self->Seconds() + (24 * 60 * 60 * ( ($years * 365) + ($months_as_days) ) ); 261 } 262 else 263 { 264 croak "Allowed argument for ApproximateInSeconds is 'over','under','average'"; 265 } 266} 267 268sub Incr 269{ 270 my $self = shift; 271 272 my $secs = $self->Seconds(); 273 274 return ref($self)->new([0, $self->Months(),0,0,0,$secs++]); 275} 276 277sub Neg 278{ 279 my $self = shift; 280 281 return ref($self)->new([0, -$self->Months(),0,0,0,-$self->Seconds()]); 282} 283 284 285#Useful methods. 286 287#Taken from Class::Date 288sub DeltaFromArray 289{ 290 my $self = shift; 291 my $input = shift; 292 my ($y,$m,$d,$hh,$mm,$ss) = @{$input}[0,1,2,3,4,5]; 293 294 $y = 0 unless (defined $y); 295 $y = floor($y * 12); 296 $m += $y; 297 return [$m||0,($ss||0)+60*(($mm||0)+60*(($hh||0)+24*($d||0)))]; 298} 299 300 301666; 302__END__ 303 304=head1 NAME 305 306Date::Handler::Delta - Time lapse object 307 308=head1 SYNOPSIS 309 310 use Date::Handler::Delta; 311 312 my $delta = new Date::Handler::Delta([3,1,10,2,5,5]); 313 my $delta = new Date::Handler::Delta({ 314 years => 3, 315 months => 1, 316 days => 10, 317 hours => 2, 318 minutes => 5, 319 seconds => 5, 320 }); 321 322 $delta->new (More information in perldoc Date::Handler::Delta) 323 $delta->Months() Number of months in delta 324 $delta->Seconds() Number of seconds in delta 325 $delta->AsScalar() "%d months and %d seconds" 326 $delta->AsNumber() "%d-%d-%d" 327 $delta->AsArray() [y,m,ss] 328 $delta->AsHash() { months => m, seconds => ss } 329 330 $date + $delta = Date::Handler 331 $date - $delta = Date::Handler 332 $date - $date2 = Date::Handler::Delta 333 $date + n = (+n seconds) 334 $date - n = (-n seconds) 335 336 $delta + $delta = Date::Handler::Delta 337 $delta - $delta = Date::Handler::Delta 338 $delta * n = Date::Handler::Delta 339 $delta / n = Date::Handler::Delta 340 $delta + n = (+n seconds) 341 $delta - n = (-n seconds) 342 343 344 345=head1 DESCRIPTION 346 347 348Date::Handler::Delta is an object that represents a lapse of time. It's internal representation 349of a time lapse if reduced to months and seconds. A Date::Handler::Delta object is always relative 350to a Date::Handler object, it's calculation methods become active when the delta is applied to a date. 351 352 353=head1 IMPLEMENTATION 354 355Implementation details 356 357=head2 Creating a Date::Handler::Delta object 358 359The new() constructor receives only one argument as an array reference or hash reference: 360 361 my $delta = Date::Handler::Delta->new([1,3,5,0,0]); 362 my $delta = Date::Handler::Delta->new({ 363 years => 1, 364 months => 3, 365 days => 5, 366 minutes= > 0, 367 seconds => 0, 368 }); 369 370 371=over 3 372 373=item * As array reference, the order if years, months, days, minutes seconds 374 375=item * As hash reference, the keys are years, months, days, minutes, seconds. 376 377=back 378 379 380=head2 Accessors 381 382 383You can access the data inside the object using any of the provided methods. 384These methods are detailed in the SYNOPSIS up above. 385 386 387Since Date::Handler uses operator overloading, you can 'apply' a Delta object on an absolute date 388simply by using built-in operators. 389 390Example: 391 392 #A Delta of 1 year. 393 my $delta = new Date::Handler::Delta([1,0,0,0,0,0]); 394 395 my $date = new Date::Handler({ date => time } ); 396 397 #$newdate is now one year in the furure. 398 my $newdate = $date+$delta; 399 400 401=head2 Operator overload special cases 402 403The Date::Handler overloaded operator have special cases. Refer to the 404SYNOPSIS to get a description of each overloaded operator's behaviour. 405 406One special case of the overload is when adding an integer 'n' to a Date::Handler's reference. This is treated as if 'n' was in seconds. Same thing for substraction. 407 408Example Uses of the overload: 409 410 my $date = new Date::Handler({ date => 411 { 412 year => 2001, 413 month => 5, 414 day => 14, 415 hour => 5, 416 min => 0, 417 sec => 0, 418 }}); 419 #Quoted string overload 420 print "Current date is $date\n"; 421 422 my $delta = new Date::Handler::Delta({ days => 5, }); 423 424 #'+' overload, now, $date is 5 days in the future. 425 $date += $delta; 426 427 #Small clock. Not too accurate, but still ;) 428 while(1) 429 { 430 #Add one second to the date. (same as $date + 1) 431 $date++; 432 print "$date\n"; 433 sleep(1); 434 } 435 436 437=head1 BUGS (known) 438 439Deltas going after 2038 are not handled by this module yet. (POSIX) 440 441Deltas before 1902 are not handled by this module. (POSIX) 442 443If you find bugs with this module, do not hesitate to contact the author. 444Your comments and rants are welcomed :) 445 446=head1 TODO 447 448Refine reduction to simplest expression of the delta. 449 450=head1 COPYRIGHT 451 452Copyright(c) 2001 Benoit Beausejour <bbeausej@pobox.com> 453 454All rights reserved. This program is free software; you can redistribute it and/or modify it under the same 455terms as Perl itself. 456 457Portions Copyright (c) Philippe M. Chiasson <gozer@cpan.org> 458 459Portions Copyright (c) Szab�, Bal�zs <dlux@kapu.hu> 460 461Portions Copyright (c) Larry Rosler 462 463 464=head1 AUTHOR 465 466Benoit Beausejour <bbeausej@pobox.com> 467 468=head1 SEE ALSO 469 470Date::Handler(1). 471Date::Handler::Range(1). 472Class::Date(1). 473Time::Object(1). 474Date::Calc(1). 475perl(1). 476 477=cut 478 479