view Lib/MyDateTime.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
parents 190c794a41ae
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;