Mercurial > pub > Impl

changeset 85:190c794a41ae

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DateTime renamed because of collision
author wizard
date Fri, 16 Apr 2010 16:33:11 +0400
parents e568c7c8b743
children 52eeec77504b
files Lib/DateTime.pm Lib/MyDateTime.pm
diffstat 2 files changed, 312 insertions(+), 312 deletions(-) [+]
line wrap: on
line diff
--- 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;
--- /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;