Mercurial > pub > Impl
diff Lib/MyDateTime.pm @ 85:190c794a41ae
DateTime renamed because of collision
author | wizard |
---|---|
date | Fri, 16 Apr 2010 16:33:11 +0400 |
parents | Lib/DateTime.pm@16ada169ca75 |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/MyDateTime.pm Fri Apr 16 16:33:11 2010 +0400 @@ -0,0 +1,312 @@ +use strict; +package DateTime::Span; +package DateTime; +use Common; +use Time::Local; +use Time::Zone; +use Date::Format; +our @ISA = qw(Object); + +use overload + '+' => \&opAdd, + '-' => \&opSubtract, + '<=>' => \&opCompare, + 'bool' => \&opAsBool, + 'fallback' => 1, + '""' => \&opAsString; + +BEGIN { + DeclareProperty UnixTime => ACCESS_READ; +} + +sub CTOR { + my $this = shift; + + if (@_ >= 2) { + my(%args) = @_; + + $this->{$UnixTime} = $args{UnixTime} or die new Exception("A correct unix time value is required"); + } else { + $this->{$UnixTime} = $this->ParseISOTime(shift,'+000'); + } +} + +sub ParseISOTime { + my ($class,$time,$timezone) = @_; + + if ($time =~ /^(\d{4})-(\d{2})-(\d{2})(?:.(\d{2}):(\d{2}):(\d{2})(?:\.\d{3})?)?/ ) { + my ($yyyy,$mm,$dd,$hh,$MM,$SS) = ($1-1900,$2-1,$3,$4 || 0,$5 || 0,$6 || 0); + if ($timezone) { + return tz_offset($timezone) + timegm($SS,$MM,$hh,$dd,$mm,$yyyy); + } else { + return timelocal($SS,$MM,$hh,$dd,$mm,$yyyy); + } + } else { + die new Exception("The specified string isn\'t a correct ISO date",$time); + } +} + +sub new_ISO { + my ($class,$ISOTime,$zone) = @_; + return $class->new(UnixTime => $class->ParseISOTime($ISOTime,$zone)); +} + +sub now { + my ($class) = @_; + return $class->new(UnixTime => time); +} + +sub AsISOString { + my ($this,$zone) = @_; + return time2str("%Y-%m-%dT%H:%M:%S",$this->{$UnixTime},$zone); +} + +sub AsFormatString { + my ($this,$format,$zone) = @_; + return time2str($format,$this->{$UnixTime},$zone); +} + +sub opAdd { + my ($a,$b,$flag) = @_; + + if (UNIVERSAL::isa($b,'DateTime::Span')) { + return new DateTime(UnixTime => $a->{$UnixTime} + $b->SecondsSpan); + } elsif (not ref $b){ + return new DateTime(UnixTime => $a->UnixTime + $b); + } else { + die new Exception("Only a time span can be added to the DateTime object",$b); + } +} + +sub GetDate { + my ($this) = @_; + + return DateTime->new_ISO($this->AsFormatString('%Y-%m-%d')); +} + +sub opSubtract { + my ($a,$b,$flag) = @_; + + if (UNIVERSAL::isa($b,'DateTime')) { + return new DateTime::Span(Seconds => $a->{$UnixTime}-$b->{$UnixTime}); + } elsif (UNIVERSAL::isa($b,'DateTime::Span')) { + return new DateTime(UnixTime => $flag ? $b->SecondsSpan - $a->UnixTime: $a->UnixTime - $b->SecondsSpan); + } elsif (not ref $b){ + return new DateTime(UnixTime => $flag ? $b - $a->UnixTime : $a->UnixTime - $b); + } else { + die new Exception("Only an another DateTime object or a time span can be subtracted from the DateTime",$b); + } +} + +sub opCompare { + my ($a,$b,$flag) = @_; + + if (UNIVERSAL::isa($b,'DateTime')) { + return $flag ? $b->{$UnixTime} <=> $a->{$UnixTime} : $a->{$UnixTime} <=> $b->{$UnixTime}; + } else { + die new Exception("Only a DateTime object can be compared to the DateTime object", $b); + } +} + +sub opAsString { + my $this = shift; + $this->AsISOString('+000'); +} + +sub opAsBool { + 1; +} + +package DateTime::Span; +use Common; +our @ISA = qw(Object); + +use overload + '-' => \&opSub, + '+' => \&opAdd, + '<=>' => \&opCmp, + 'fallback' => 1; + +BEGIN { + DeclareProperty SecondsSpan=>ACCESS_READ; +} + +sub CTOR { + my ($this,%args) = @_; + + $this->{$SecondsSpan} = ($args{'Seconds'} || 0) + ($args{'Minutes'} || 0)*60 + ($args{'Hours'} || 0)*3600 + ($args{'Days'} || 0)*86400; +} + +sub Days { + my ($this) = @_; + + return int($this->{$SecondsSpan}/86400); +} + +sub Hours { + my ($this) = @_; + + return int($this->{$SecondsSpan}/3600); +} +sub Minutes { + my ($this) = @_; + + return int($this->{$SecondsSpan}/60); +} + +sub opAdd { + my ($a,$b,$flag) = @_; + + if (UNIVERSAL::isa($b,'DateTime::Span')) { + return new DateTime::Span(Seconds => $a->{$SecondsSpan} + $b->{$SecondsSpan}); + } elsif (not ref $b) { + return new DateTime::Span(Seconds => $a->{$SecondsSpan} + $b); + } else { + die new Exception("Only a time span can be added to the time span"); + } +} + +sub opSub { + my ($a,$b,$flag) = @_; + + if (UNIVERSAL::isa($b,'DateTime::Span')) { + return new DateTime::Span(Seconds => $flag ? $b->{$SecondsSpan} - $a->{$SecondsSpan} : $a->{$SecondsSpan} - $b->{$SecondsSpan}); + } elsif (not ref $b) { + return new DateTime::Span(Seconds => $flag ? $b - $a->{$SecondsSpan} : $a->{$SecondsSpan} - $b); + } else { + die new Exception("Only a time span can be subtracted from the time span"); + } +} + +sub opCmp { + my ($a,$b,$flag) = @_; + + if (UNIVERSAL::isa($b,'DateTime::Span')) { + return $flag ? $b->{$SecondsSpan} <=> $a->{$SecondsSpan} : $a->{$SecondsSpan} <=> $b->{$SecondsSpan}; + } elsif (not ref $b) { + return $flag ? $b <=> $a->{$SecondsSpan} : $a->{$SecondsSpan} <=> $b; + } else { + die new Exception("Only a time span can be compared to the time span"); + } +} + +package DateTime::TimeLine; +use Common; +our @ISA = qw(Object); + +BEGIN { + DeclareProperty Timeline => ACCESS_READ; +} + +sub CTOR { + my ($this) = @_; + + $this->{$Timeline} = [ {Date => undef} ]; +} + +# рекурсивно копирует простые структуры +sub SimpleCopy { + my ($refObject,$cache) = @_; + + return undef if not defined $refObject; + + $cache ||= {}; + + if ($cache->{$refObject}) { + return $cache->{$refObject}; + } + + local $_; + + if (ref $refObject eq 'HASH' ) { + return ($cache->{$refObject} = { map { $_, SimpleCopy($refObject->{$_},$cache) } keys %$refObject }); + } elsif (ref $refObject eq 'ARRAY' ) { + return ($cache->{$refObject} = [ map { SimpleCopy($_,$cache) } @$refObject]); + } else { + return ($cache->{$refObject} = $refObject); + } +} + +sub Split { + my ($this,$date) = @_; + + die new Exception('Can\'t split the timeline with an undefined date') unless $date; + + for (my $i = 0; $i < @{$this->{$Timeline}}; $i++) { + my $Elem = $this->{$Timeline}[$i]; + if ($Elem->{Date} and $Elem->{Date} >= $date ) { + if ($Elem->{Date} == $date) { + return $Elem; + } else { + my $newElem = SimpleCopy($this->{$Timeline}[$i-1]); + $newElem->{Date} = $date; + use Data::Dumper; + + splice @{$this->{$Timeline}},$i,0,$newElem; + return $newElem; + } + } + } + my $Elem = { Date => $date }; + push @{$this->{$Timeline}},$Elem; + return $Elem; +} + +sub Select { + my ($this,$start,$end) = @_; + + my @result; + + for (my $i=0; $i< @{$this->{$Timeline}}; $i++) { + my $Elem = $this->{$Timeline}[$i]; + my $Next = $this->{$Timeline}[$i+1]; + if ( + (not $Elem->{Date} or not $start or $Elem->{Date} < $start) + and + (not $Next->{Date} or not $start or $Next->{Date} > $start) + ) { + # ------*++++(++++*----...--)--- + push @result,$Elem; + } elsif ( + $Elem->{Date} + and + (not $start or $Elem->{Date} >= $start) + and + (not $end or $Elem->{Date} < $end ) + ) { + # ------*---(----*++...++*++)+++*---- + push @result,$Elem; + } elsif ( $Elem->{Date} and $end and $Elem->{Date} >= $end) { + last; + } + } + + return @result; +} + +sub SelectStrict { + my ($this,$start,$end) = @_; + $this->Split($start); + $this->Split($end); + return grep { + $_->{Date} + and + $start ? $_->{Date} >= $start : 1 + and + $end ? $_->{Date} < $end : 1 + } @{$this->{$Timeline}}; +} + +sub SelectAsPeriod { + my ($this,$start,$end) = @_; + + my @Dates = $this->Select($start,$end); + for (my $i = 0; $i< @Dates; $i++) { + $Dates[$i]->{Start} = $Dates[$i]->{Date}; + $Dates[$i]->{End} = $Dates[$i+1] ? $Dates[$i+1]->{Date} : undef + } + + return @Dates; +} + +1;