Mercurial > pub > Impl
view Lib/DateTime.pm @ 59:0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
Configuration infrastructure in progress (in the aspect of the lazy activation)
Initial concept for the code generator
author | wizard |
---|---|
date | Tue, 09 Mar 2010 02:50:45 +0300 |
parents | 16ada169ca75 |
children |
line wrap: on
line source
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;