diff Lib/DateTime.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/DateTime.pm	Tue Jul 14 12:54:37 2009 +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;