# HG changeset patch # User wizard # Date 1271421191 -14400 # Node ID 190c794a41aeb6c3d586c9007520942f05c5666a # Parent e568c7c8b743fcc3ba446136529333c646ea3519 DateTime renamed because of collision diff -r e568c7c8b743 -r 190c794a41ae Lib/DateTime.pm --- a/Lib/DateTime.pm Wed Apr 14 17:38:11 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,312 +0,0 @@ -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; diff -r e568c7c8b743 -r 190c794a41ae Lib/MyDateTime.pm --- /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;