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;