1#!/usr/bin/perl
2package Date::Handler;
3
4use strict;
5use Carp;
6use Data::Dumper;
7use vars qw(@ISA $VERSION);
8
9$VERSION = '1.2';
10
11use POSIX qw(floor strftime mktime setlocale);
12
13use Date::Handler::Constants;
14use constant DEFAULT_FORMAT_STRING => '%c';
15use constant DEFAULT_TIMEZONE => 'GMT';
16use constant DEFAULT_LOCALE => 'en_US.ISO8859-15';
17
18use constant DELTA_CLASS => 'Date::Handler::Delta';
19
20use constant INTUITIVE_MONTH_CALCULATIONS => 0;
21use constant INTUITIVE_TIME_CALCULATIONS => 0;
22use constant INTUITIVE_DST_ADJUSTMENTS => 0;
23
24use overload (
25	'""'	=> 'AsScalar',
26	'0+'	=> 'AsNumber',
27	'+'	=>	'Add',
28	'-'	=>	'Sub',
29	'<=>'	=>	'Cmp',
30	'++' => 'Incr',
31	'*' => sub { croak "Cannot multiply an absolute date"; },
32	'**' => sub { croak "Cannot power an absolute date"; },
33	'/' => sub { croak "Cannot divide an absolute date"; },
34	fallback	=> 1,
35);
36
37
38sub new
39{
40	my $classname = shift;
41	my $args = shift;
42
43
44	# Allow classic style arguments passing. # Thanks to Roland Rauch <roland@rauch.com> for the spot
45	unless (ref($args) eq "HASH")
46	{
47		unshift(@_, $args);
48		$args = {@_};
49	}
50
51	my $self = {};
52	bless $self, $classname;
53
54	croak "No args to new()" if not defined $args;
55	croak "Argument to new() is not a hashref" if not ref($args) =~ /HASH/;
56	croak "No date specified for new()" if not defined $args->{date};
57
58	my $date = $args->{date};
59
60	my $timezone = $args->{time_zone} || $self->DEFAULT_TIMEZONE();
61	$self->TimeZone($timezone);
62
63	$self->{locale} = "";
64	if(defined $args->{locale})
65	{
66		$self->SetLocale($args->{locale}) || $self->SetLocale($self->DEFAULT_LOCALE());
67	}
68	else
69	{
70		$self->SetLocale($self->DEFAULT_LOCALE());
71	}
72
73	if(not defined $self->Locale())
74	{
75		warn "Impossible to set locale OR default locale correctly. Defaulting to GMT/UTC.";
76		$self->SetLocale('GMT');
77	}
78
79
80	if(ref($date) =~ /SCALAR/)
81	{
82		if($date !~ /\s/ && $date !~ /[A-Za-z]/)
83		{
84			$self->{epoch} = $date;
85		}
86	}
87	elsif(ref($date) =~ /ARRAY/)
88	{
89		$self->{epoch} = $self->Array2Epoch($date);
90	}
91	elsif(ref($date) =~ /HASH/)
92	{
93		$self->{epoch} = $self->Array2Epoch([
94						$date->{year},
95						$date->{month},
96						$date->{day},
97						$date->{hour},
98						$date->{min},
99						$date->{sec},
100		]);
101	}
102	else
103	{
104		if($date !~ /\s/ && $date !~ /[A-Za-z]/)
105		{
106			$self->{epoch} = $date;
107		}
108	}
109
110	$self->{_intuitive_day} = $args->{intuitive_day} if($self->INTUITIVE_MONTH_CALCULATIONS());
111	$self->{_intuitive_hour} = $args->{intuitive_hour} if($self->INTUITIVE_TIME_CALCULATIONS());
112
113	croak "Date format not recognized." if not defined $self->{epoch};
114
115	return $self;
116}
117
118
119#Accessors (Might want to optimised some of those)
120sub Year { return shift->AsArray()->[0]; }
121sub Day { return shift->AsArray()->[2]; }
122sub Hour { return shift->AsArray()->[3]; }
123sub Min { return shift->AsArray()->[4]; }
124sub Sec { return shift->AsArray()->[5]; }
125
126
127#To be consistent with our WeekDay function, wich is zero based.
128sub Month
129{
130	my $self = shift;
131
132	local $ENV{'TZ'} = $self->TimeZone();
133	local $ENV{'LC_TIME'} = $self->Locale();
134
135	return strftime('%m', localtime($self->{epoch}));
136}
137
138sub Epoch
139{
140	my $self = shift;
141
142	if(@_)
143	{
144		my $epoch = shift;
145
146		$self->{epoch} = $epoch;
147	}
148
149	return $self->{epoch};
150}
151
152sub TimeZone
153{
154	my $self = shift;
155
156	if(@_)
157	{
158		my $time_zone = shift;
159		$self->{time_zone} = $time_zone;
160	}
161
162	return $self->{time_zone};
163}
164
165sub Locale
166{
167	my $self = shift;
168
169	if(@_)
170	{
171		warn "Calling Locale() with an argument to set the locale is deprecated. Please use SetLocale(locale) instead.\n";
172
173		return $self->SetLocale(@_);
174	}
175
176	return $self->{locale};
177}
178
179sub SetLocale
180{
181	my $self = shift;
182	my $locale = shift;
183
184	croak "No locale passed to SetLocale()" if not defined $locale;
185
186	my $locale_return = POSIX::setlocale(&POSIX::LC_TIME, $locale);
187
188	if( defined $locale_return )
189	{
190		$self->{locale} = $locale;
191		$self->{locale_realname} = $locale_return;
192
193		return $self->{locale};
194	}
195
196	print STDERR "Locale $locale does not seem to be implemented on this system, keeping locale ".$self->{locale}."\n";
197	return undef;
198}
199
200
201sub LocaleRealName
202{
203	my $self = shift;
204
205	return $self->{locale_realname} || $self->DEFAULT_LOCALE();
206}
207
208#Time Conversion and info methods
209
210sub TimeZoneName
211{
212	my $self = shift;
213
214	local $ENV{'TZ'} = $self->TimeZone();
215	local $ENV{'LC_TIME'} = $self->Locale();
216
217	#Old code.
218	#my ($std,$dst) = POSIX::tzname();
219	#return $std." / ".$dst;
220
221	return strftime("%Z", localtime($self->{epoch}) );
222}
223
224sub LocalTime
225{
226	my $self = shift;
227
228	local $ENV{'TZ'} = $self->TimeZone();
229	local $ENV{'LC_TIME'} = $self->Locale();
230
231	return localtime($self->{epoch});
232}
233
234
235sub TimeFormat
236{
237	my $self = shift;
238	my $format_string = shift;
239
240	local $ENV{'TZ'} = $self->TimeZone();
241	local $ENV{'LC_TIME'} = $self->Locale();
242
243	$format_string ||= $self->DEFAULT_FORMAT_STRING();
244
245	return strftime($format_string, localtime($self->{epoch}));
246}
247
248
249sub GmtTime
250{
251	my $self = shift;
252
253	local $ENV{'TZ'} = $self->TimeZone();
254	local $ENV{'LC_TIME'} = $self->Locale();
255
256	return gmtime($self->{epoch});
257}
258
259sub UtcTime
260{
261	my $self = shift;
262
263	local $ENV{'TZ'} = $self->TimeZone();
264	local $ENV{'LC_TIME'} = $self->Locale();
265
266	return gmtime($self->{epoch});
267}
268
269
270#Idea and base code for this function from:
271# Larry Rosler, February 13, 1999, Thanks Larry! -<bbeausej@pobox.com>
272
273sub GmtOffset
274{
275	my $self = shift;
276
277	local $ENV{'TZ'} = $self->TimeZone();
278	local $ENV{'LC_TIME'} = $self->Locale();
279
280	#Old code.
281	#use Time::Local;
282	#my $gmt_time = timegm( gmtime $self->{epoch} );
283	#my $local_time = timelocal( gmtime $self->{epoch} );
284
285
286	my $now = $self->Epoch();
287
288	my ($l_min, $l_hour, $l_year, $l_yday) = (localtime $now)[1, 2, 5, 7];
289	my ($g_min, $g_hour, $g_year, $g_yday) = (gmtime $now)[1, 2, 5, 7];
290
291	return (($l_min - $g_min)/60 + $l_hour - $g_hour + 24 * ($l_year - $g_year || $l_yday - $g_yday)) * 3600;
292}
293
294
295#Useful methods
296sub MonthName
297{
298	my $self = shift;
299
300	local $ENV{'TZ'} = $self->TimeZone();
301	local $ENV{'LC_TIME'} = $self->Locale();
302
303	return strftime('%B', localtime($self->{epoch}));
304}
305
306sub WeekDay
307{
308	my $self = shift;
309
310	local $ENV{'TZ'} = $self->TimeZone();
311	local $ENV{'LC_TIME'} = $self->Locale();
312
313	return strftime('%u', localtime($self->{epoch}));
314}
315
316sub WeekDayName
317{
318	my $self = shift;
319
320	local $ENV{'TZ'} = $self->TimeZone();
321	local $ENV{'LC_TIME'} = $self->Locale();
322
323	return strftime('%A', localtime($self->{epoch}));
324}
325
326sub FirstWeekDayOfMonth
327{
328	my $self = shift;
329
330	local $ENV{'TZ'} = $self->TimeZone();
331	local $ENV{'LC_TIME'} = $self->Locale();
332
333	return (($self->WeekDay() - $self->Day() % 7) + 8) % 7;
334}
335
336sub WeekOfMonth
337{
338	my $self = shift;
339
340	local $ENV{'TZ'} = $self->TimeZone();
341	local $ENV{'LC_TIME'} = $self->Locale();
342
343	return int(($self->Day() + $self->FirstWeekDayOfMonth() - 1) / 7) + 1;
344}
345
346
347sub DaysInMonth
348{
349	my $self = shift;
350
351	local $ENV{'TZ'} = $self->TimeZone();
352	local $ENV{'LC_TIME'} = $self->Locale();
353
354	my $month = $self->Month() - 1;
355
356	if($month == 1) #Feb
357	{
358		return 29 if $self->IsLeapYear();
359		return 28;
360	}
361	else
362	{
363		return $DAYS_IN_MONTH->{$month};
364	}
365}
366
367sub DayLightSavings
368{
369	my $self = shift;
370
371	local $ENV{'TZ'} = $self->TimeZone();
372	local $ENV{'LC_TIME'} = $self->Locale();
373
374	my @self_localtime = localtime($self->{epoch});
375
376	return $self_localtime[8];
377}
378
379sub DayOfYear
380{
381	my $self = shift;
382
383	local $ENV{'TZ'} = $self->TimeZone();
384	local $ENV{'LC_TIME'} = $self->Locale();
385
386	my @self_localtime = localtime($self->{epoch});
387
388	return $self_localtime[7];
389}
390
391sub DaysInYear
392{
393	my $self = shift;
394
395	local $ENV{'TZ'} = $self->TimeZone();
396	local $ENV{'LC_TIME'} = $self->Locale();
397
398	return 365 if !$self->IsLeapYear();
399	return 366 if $self->IsLeapYear();
400}
401
402sub DaysLeftInYear
403{
404	my $self = shift;
405
406	local $ENV{'TZ'} = $self->TimeZone();
407	local $ENV{'LC_TIME'} = $self->Locale();
408
409	my $days = $self->DaysInYear();
410	my $day = $self->DayOfYear();
411
412	return $days - $day;
413}
414
415sub LastDayOfMonth
416{
417	my $self = shift;
418
419	local $ENV{'TZ'} = $self->TimeZone();
420	local $ENV{'LC_TIME'} = $self->Locale();
421
422	if($self->Day() >= $self->DaysInMonth())
423	{
424		return 1;
425	}
426
427}
428
429sub IsLeapYear
430{
431	my $self = shift;
432
433	local $ENV{'TZ'} = $self->TimeZone();
434	local $ENV{'LC_TIME'} = $self->Locale();
435
436	my $year = $self->Year();
437
438	return 1 if( !($year % 400) );
439	return 1 if( !($year %4) && ($year % 100) );
440	return 0;
441}
442
443sub IntuitiveDay
444{
445	my $self = shift;
446	my $intuitive_day = shift;
447
448	if($intuitive_day)
449	{
450		$self->{_intuitive_day} = $intuitive_day;
451	}
452	return $self->{_intuitive_day};
453}
454
455sub IntuitiveHour
456{
457	my $self = shift;
458	my $intuitive_hour = shift;
459
460	if($intuitive_hour)
461	{
462		$self->{_intuitive_hour} = $intuitive_hour;
463	}
464	return $self->{_intuitive_hour};
465}
466
467sub Array2Epoch
468{
469	my $self = shift;
470	my $input = shift;
471
472	my ($y,$m,$d,$h,$mm,$ss) = @{$input}[0,1,2,3,4,5];
473
474	local $ENV{'TZ'} = $self->TimeZone();
475	local $ENV{'LC_TIME'} = $self->Locale();
476
477	return mktime(
478							$ss || 0,
479							$mm || 0,
480							$h || 0,
481							$d || 1,
482							($m || 1)-1,
483							($y || 2000)-1900,
484							0,
485							0,
486							-1);
487}
488
489
490#Oveload methods.
491
492sub AsScalar { return shift->TimeFormat(shift); }
493sub AsNumber { return shift->{epoch}; }
494
495sub AsArray
496{
497	my $self = shift;
498
499	local $ENV{'TZ'} = $self->TimeZone();
500	local $ENV{'LC_TIME'} = $self->Locale();
501
502
503	my ($ss,$mm,$h,$d,$m,$y) = localtime($self->{epoch});
504	$y += 1900;
505	$m += 1;
506
507	return [$y,$m,$d,$h,$mm,$ss];
508}
509
510sub AsHash
511{
512	my $self = shift;
513
514	my $self_array = $self->AsArray();
515
516	return {
517				year => $self_array->[0],
518				month => $self_array->[1],
519				day => $self_array->[2],
520				hour => $self_array->[3],
521				min => $self_array->[4],
522				sec => $self_array->[5],
523	};
524}
525
526
527sub Add
528{
529	my ($self, $delta) = @_;
530
531	if(!ref($delta))
532	{
533		$delta = $self->DELTA_CLASS()->new([0,0,0,0,0,$delta]);
534		return $self + $delta;
535	}
536	elsif($delta->isa($self->DELTA_CLASS()))
537	{
538		local $ENV{'TZ'} = $self->TimeZone();
539		local $ENV{'LC_TIME'} = $self->Locale();
540
541
542		my $epoch = $self->{epoch};
543
544		my $newdate = ref($self)->new({ date => $epoch, time_zone => $self->TimeZone() });
545
546		my $self_array = $newdate->AsArray();
547		#Take care of the months.
548		$self_array->[1] += $delta->Months();
549
550		my $years = floor(($self_array->[1]-1)/12);
551		$self_array->[1] -= 12*$years;
552
553		#Take care of the years.
554		$self_array->[0] += $years;
555
556		my $posix_date = ref($self)->new({ date => $self_array,
557						 time_zone => $self->TimeZone(),
558		});
559
560		if($self->INTUITIVE_MONTH_CALCULATIONS())
561		{
562			if((($self->Month() + $delta->Months() - 1) % 12 + 1) != $posix_date->Month())
563			{
564				my $compensation_seconds = 86400 * $posix_date->Day();
565				my $compensated_epoch = $posix_date->Epoch();
566
567				$compensated_epoch -= $compensation_seconds;
568
569				$posix_date->Epoch($compensated_epoch);
570
571				$posix_date->{_intuitive_day} = $self->{_intuitive_day} || $self->Day();
572			}
573			else
574			{
575				if($self->{_intuitive_day})
576				{
577					my $lastdayofmonth = $self->{_intuitive_day};
578					my $compensated_seconds = 86400 * ($lastdayofmonth - $posix_date->Day());
579					if($compensated_seconds > 0)
580					{
581						my $epoch = $posix_date->Epoch();
582						$epoch += $compensated_seconds;
583						$posix_date->Epoch($epoch);
584					}
585
586					if($self->{_intuitive_day} > $lastdayofmonth)
587					{
588						$posix_date->{_intuitive_day} = $self->{_intuitive_day};
589					}
590
591				}
592			}
593		}
594
595		#Take care of the seconds
596		my $posix_epoch = $posix_date->Epoch();
597		$posix_epoch += $delta->Seconds();
598		$posix_date->Epoch($posix_epoch);
599
600
601		my $adjustment_epoch = $posix_date->Epoch();
602		my $add_intuitive_hour = 0;
603		my $intuitive_hour;
604
605		if($posix_date->DayLightSavings() && !$self->DayLightSavings())
606		{
607			my $posix_hour = $posix_date->Hour();
608			$posix_hour -= 1;
609			$intuitive_hour = $posix_hour;
610
611			if($self->INTUITIVE_DST_ADJUSTMENTS())
612			{
613				$adjustment_epoch -= 3600;
614				$posix_date->Epoch($adjustment_epoch);
615
616				$posix_hour = 0 if $posix_hour == 24;
617				if($posix_date->Hour() != $posix_hour)
618				{
619					$add_intuitive_hour = 1;
620					$adjustment_epoch += 3600;
621					$posix_date->Epoch($adjustment_epoch);
622				}
623			}
624		}
625		elsif(!$posix_date->DayLightSavings() && $self->DayLightSavings())
626		{
627
628			my $posix_hour = $posix_date->Hour();
629			$posix_hour += 1;
630			$intuitive_hour = $posix_hour;
631
632			if($self->INTUITIVE_DST_ADJUSTMENTS())
633			{
634				$adjustment_epoch += 3600;
635				$posix_date->Epoch($adjustment_epoch);
636
637				$posix_hour = 0 if $posix_hour == 24;
638				if($posix_date->Hour() != $posix_hour)
639				{
640					$add_intuitive_hour = 1;
641					$adjustment_epoch -= 3600;
642					$posix_date->Epoch($adjustment_epoch);
643				}
644			}
645		}
646
647		if($self->INTUITIVE_TIME_CALCULATIONS())
648		{
649			if($add_intuitive_hour)
650			{
651				$posix_date->{_intuitive_hour} = $intuitive_hour;
652			}
653
654			if(defined $self->{_intuitive_hour})
655			{
656				my $hour = $posix_date->Hour();
657				my $intuitive_epoch = $posix_date->Epoch();
658
659				if($hour > $self->{_intuitive_hour})
660				{
661					$intuitive_epoch -= 3600;
662					$posix_date->Epoch($intuitive_epoch);
663				}
664				#elsif($hour < $self->{_intuitive_hour})
665				#{
666				#	print STDERR "Intuitive Adjust +1 hour\n";
667				#	$intuitive_epoch += 3600;
668				#	$posix_date->Epoch($intuitive_epoch);
669				#}
670			}
671		}
672
673		return $posix_date;
674
675	}
676	else
677	{
678		croak "Trying to add/substract an unknown object to a Date::Handler";
679	}
680}
681
682
683sub Sub
684{
685	my ($self, $delta) = @_;
686
687	if(!ref($delta))
688	{
689		$delta = $self->DELTA_CLASS()->new([0,0,0,0,0,$delta]);
690		return $self - $delta;
691	}
692	elsif($delta->isa($self->DELTA_CLASS()))
693	{
694		return $self->Add(-$delta);
695	}
696	elsif($delta->isa('Date::Handler'))
697	{
698
699		my $seconds = $self->Epoch() - $delta->Epoch();
700
701		if(($self->DayLightSavings() && !$delta->DayLightSavings()) ||
702		   !$self->DayLightSavings() && $delta->DayLightSavings())
703		{
704			$seconds += 3600;
705		}
706
707		return $self->DELTA_CLASS()->new($seconds);
708	}
709	else
710	{
711		croak "Cannot substract something else than a ".$self->DELTA_CLASS()." or Date::Handler or constant from a Date::Handler";
712	}
713}
714
715
716sub Cmp
717{
718	my ($self, $date, $reverse) = @_;
719
720	my $cmp_date;
721
722	if(!ref($date))
723	{
724		$cmp_date = $date;
725	}
726	elsif($date->isa('Date::Handler'))
727	{
728		$cmp_date = $date->{epoch};
729	}
730	elsif($date->isa($self->DELTA_CLASS()))
731	{
732		croak "Cannot compare a Date::Handler to a Delta.";
733	}
734	else
735	{
736		croak "Trying to compare a Date::Handler to an unknown object.";
737	}
738
739	return $self->{epoch} <=> $cmp_date;
740}
741
742sub Incr
743{
744	my ($self) = @_;
745
746	my $epoch = $self->{epoch};
747	$epoch++;
748
749	return ref($self)->new({ date => $epoch, time_zone => $self->TimeZone() });
750}
751
752
753sub AllInfo
754{
755	my $self = shift;
756	my $out_string;
757
758	local $ENV{'TZ'} = $self->TimeZone();
759	local $ENV{'LC_TIME'} = $self->Locale();
760
761	$out_string .= "LocalTime: ".$self->LocalTime()."\n";
762	$out_string .= "TimeFormat: ".$self->TimeFormat()."\n";
763	$out_string .= "Epoch: ".$self->Epoch()."\n";
764	$out_string .= "Locale: ".$self->Locale()."\n";
765	$out_string .= "LocaleRealName: ".$self->LocaleRealName()."\n";
766	$out_string .= "TimeZone: ".$self->TimeZone()." (".$self->TimeZoneName().")\n";
767	$out_string .= "DayLightSavings: ".$self->DayLightSavings()."\n";
768	$out_string .= "GMT Time: ".$self->GmtTime()."\n";
769	$out_string .= "GmtOffset: ".$self->GmtOffset()." (".($self->GmtOffset() / 60 / 60).")\n";
770	$out_string .= "Year: ".$self->Year()."\n";
771	$out_string .= "Month: ".$self->Month()."\n";
772	$out_string .= "Day: ".$self->Day()."\n";
773	$out_string .= "Hour: ".$self->Hour()."\n";
774	$out_string .= "Min: ".$self->Min()."\n";
775	$out_string .= "Sec: ".$self->Sec()."\n";
776	$out_string .= "WeekDay: ".$self->WeekDay()."\n";
777	$out_string .= "WeekDayName: ".$self->WeekDayName()."\n";
778	$out_string .= "FirstWeekDayOfMonth: ".$self->FirstWeekDayOfMonth()."\n";
779	$out_string .= "WeekOfMonth: ".$self->WeekOfMonth()."\n";
780	$out_string .= "DayOfYear: ".$self->DayOfYear()."\n";
781	$out_string .= "MonthName: ".$self->MonthName()."\n";
782	$out_string .= "DaysInMonth: ".$self->DaysInMonth()."\n";
783	$out_string .= "Leap Year: ".$self->IsLeapYear()."\n";
784	$out_string .= "DaysInYear: ".$self->DaysInYear()."\n";
785	$out_string .= "DaysLeftInYear: ".$self->DaysLeftInYear()."\n";
786	$out_string .= "Intuitive Day: ".$self->IntuitiveDay()."\n";
787	$out_string .= "Intuitive Hour: ".$self->IntuitiveHour()."\n";
788	$out_string .= "\n\n";
789	return $out_string;
790}
791
792666;
793__END__
794