|
0
|
1 use strict;
|
|
|
2 package DateTime::Span;
|
|
|
3 package DateTime;
|
|
|
4 use Common;
|
|
|
5 use Time::Local;
|
|
|
6 use Time::Zone;
|
|
|
7 use Date::Format;
|
|
|
8 our @ISA = qw(Object);
|
|
|
9
|
|
|
10 use overload
|
|
|
11 '+' => \&opAdd,
|
|
|
12 '-' => \&opSubtract,
|
|
|
13 '<=>' => \&opCompare,
|
|
|
14 'bool' => \&opAsBool,
|
|
|
15 'fallback' => 1,
|
|
|
16 '""' => \&opAsString;
|
|
|
17
|
|
|
18 BEGIN {
|
|
|
19 DeclareProperty UnixTime => ACCESS_READ;
|
|
|
20 }
|
|
|
21
|
|
|
22 sub CTOR {
|
|
|
23 my $this = shift;
|
|
|
24
|
|
|
25 if (@_ >= 2) {
|
|
|
26 my(%args) = @_;
|
|
|
27
|
|
|
28 $this->{$UnixTime} = $args{UnixTime} or die new Exception("A correct unix time value is required");
|
|
|
29 } else {
|
|
|
30 $this->{$UnixTime} = $this->ParseISOTime(shift,'+000');
|
|
|
31 }
|
|
|
32 }
|
|
|
33
|
|
|
34 sub ParseISOTime {
|
|
|
35 my ($class,$time,$timezone) = @_;
|
|
|
36
|
|
|
37 if ($time =~ /^(\d{4})-(\d{2})-(\d{2})(?:.(\d{2}):(\d{2}):(\d{2})(?:\.\d{3})?)?/ ) {
|
|
|
38 my ($yyyy,$mm,$dd,$hh,$MM,$SS) = ($1-1900,$2-1,$3,$4 || 0,$5 || 0,$6 || 0);
|
|
|
39 if ($timezone) {
|
|
|
40 return tz_offset($timezone) + timegm($SS,$MM,$hh,$dd,$mm,$yyyy);
|
|
|
41 } else {
|
|
|
42 return timelocal($SS,$MM,$hh,$dd,$mm,$yyyy);
|
|
|
43 }
|
|
|
44 } else {
|
|
|
45 die new Exception("The specified string isn\'t a correct ISO date",$time);
|
|
|
46 }
|
|
|
47 }
|
|
|
48
|
|
|
49 sub new_ISO {
|
|
|
50 my ($class,$ISOTime,$zone) = @_;
|
|
|
51 return $class->new(UnixTime => $class->ParseISOTime($ISOTime,$zone));
|
|
|
52 }
|
|
|
53
|
|
|
54 sub now {
|
|
|
55 my ($class) = @_;
|
|
|
56 return $class->new(UnixTime => time);
|
|
|
57 }
|
|
|
58
|
|
|
59 sub AsISOString {
|
|
|
60 my ($this,$zone) = @_;
|
|
|
61 return time2str("%Y-%m-%dT%H:%M:%S",$this->{$UnixTime},$zone);
|
|
|
62 }
|
|
|
63
|
|
|
64 sub AsFormatString {
|
|
|
65 my ($this,$format,$zone) = @_;
|
|
|
66 return time2str($format,$this->{$UnixTime},$zone);
|
|
|
67 }
|
|
|
68
|
|
|
69 sub opAdd {
|
|
|
70 my ($a,$b,$flag) = @_;
|
|
|
71
|
|
|
72 if (UNIVERSAL::isa($b,'DateTime::Span')) {
|
|
|
73 return new DateTime(UnixTime => $a->{$UnixTime} + $b->SecondsSpan);
|
|
|
74 } elsif (not ref $b){
|
|
|
75 return new DateTime(UnixTime => $a->UnixTime + $b);
|
|
|
76 } else {
|
|
|
77 die new Exception("Only a time span can be added to the DateTime object",$b);
|
|
|
78 }
|
|
|
79 }
|
|
|
80
|
|
|
81 sub GetDate {
|
|
|
82 my ($this) = @_;
|
|
|
83
|
|
|
84 return DateTime->new_ISO($this->AsFormatString('%Y-%m-%d'));
|
|
|
85 }
|
|
|
86
|
|
|
87 sub opSubtract {
|
|
|
88 my ($a,$b,$flag) = @_;
|
|
|
89
|
|
|
90 if (UNIVERSAL::isa($b,'DateTime')) {
|
|
|
91 return new DateTime::Span(Seconds => $a->{$UnixTime}-$b->{$UnixTime});
|
|
|
92 } elsif (UNIVERSAL::isa($b,'DateTime::Span')) {
|
|
|
93 return new DateTime(UnixTime => $flag ? $b->SecondsSpan - $a->UnixTime: $a->UnixTime - $b->SecondsSpan);
|
|
|
94 } elsif (not ref $b){
|
|
|
95 return new DateTime(UnixTime => $flag ? $b - $a->UnixTime : $a->UnixTime - $b);
|
|
|
96 } else {
|
|
|
97 die new Exception("Only an another DateTime object or a time span can be subtracted from the DateTime",$b);
|
|
|
98 }
|
|
|
99 }
|
|
|
100
|
|
|
101 sub opCompare {
|
|
|
102 my ($a,$b,$flag) = @_;
|
|
|
103
|
|
|
104 if (UNIVERSAL::isa($b,'DateTime')) {
|
|
|
105 return $flag ? $b->{$UnixTime} <=> $a->{$UnixTime} : $a->{$UnixTime} <=> $b->{$UnixTime};
|
|
|
106 } else {
|
|
|
107 die new Exception("Only a DateTime object can be compared to the DateTime object", $b);
|
|
|
108 }
|
|
|
109 }
|
|
|
110
|
|
|
111 sub opAsString {
|
|
|
112 my $this = shift;
|
|
|
113 $this->AsISOString('+000');
|
|
|
114 }
|
|
|
115
|
|
|
116 sub opAsBool {
|
|
|
117 1;
|
|
|
118 }
|
|
|
119
|
|
|
120 package DateTime::Span;
|
|
|
121 use Common;
|
|
|
122 our @ISA = qw(Object);
|
|
|
123
|
|
|
124 use overload
|
|
|
125 '-' => \&opSub,
|
|
|
126 '+' => \&opAdd,
|
|
|
127 '<=>' => \&opCmp,
|
|
|
128 'fallback' => 1;
|
|
|
129
|
|
|
130 BEGIN {
|
|
|
131 DeclareProperty SecondsSpan=>ACCESS_READ;
|
|
|
132 }
|
|
|
133
|
|
|
134 sub CTOR {
|
|
|
135 my ($this,%args) = @_;
|
|
|
136
|
|
|
137 $this->{$SecondsSpan} = ($args{'Seconds'} || 0) + ($args{'Minutes'} || 0)*60 + ($args{'Hours'} || 0)*3600 + ($args{'Days'} || 0)*86400;
|
|
|
138 }
|
|
|
139
|
|
|
140 sub Days {
|
|
|
141 my ($this) = @_;
|
|
|
142
|
|
|
143 return int($this->{$SecondsSpan}/86400);
|
|
|
144 }
|
|
|
145
|
|
|
146 sub Hours {
|
|
|
147 my ($this) = @_;
|
|
|
148
|
|
|
149 return int($this->{$SecondsSpan}/3600);
|
|
|
150 }
|
|
|
151 sub Minutes {
|
|
|
152 my ($this) = @_;
|
|
|
153
|
|
|
154 return int($this->{$SecondsSpan}/60);
|
|
|
155 }
|
|
|
156
|
|
|
157 sub opAdd {
|
|
|
158 my ($a,$b,$flag) = @_;
|
|
|
159
|
|
|
160 if (UNIVERSAL::isa($b,'DateTime::Span')) {
|
|
|
161 return new DateTime::Span(Seconds => $a->{$SecondsSpan} + $b->{$SecondsSpan});
|
|
|
162 } elsif (not ref $b) {
|
|
|
163 return new DateTime::Span(Seconds => $a->{$SecondsSpan} + $b);
|
|
|
164 } else {
|
|
|
165 die new Exception("Only a time span can be added to the time span");
|
|
|
166 }
|
|
|
167 }
|
|
|
168
|
|
|
169 sub opSub {
|
|
|
170 my ($a,$b,$flag) = @_;
|
|
|
171
|
|
|
172 if (UNIVERSAL::isa($b,'DateTime::Span')) {
|
|
|
173 return new DateTime::Span(Seconds => $flag ? $b->{$SecondsSpan} - $a->{$SecondsSpan} : $a->{$SecondsSpan} - $b->{$SecondsSpan});
|
|
|
174 } elsif (not ref $b) {
|
|
|
175 return new DateTime::Span(Seconds => $flag ? $b - $a->{$SecondsSpan} : $a->{$SecondsSpan} - $b);
|
|
|
176 } else {
|
|
|
177 die new Exception("Only a time span can be subtracted from the time span");
|
|
|
178 }
|
|
|
179 }
|
|
|
180
|
|
|
181 sub opCmp {
|
|
|
182 my ($a,$b,$flag) = @_;
|
|
|
183
|
|
|
184 if (UNIVERSAL::isa($b,'DateTime::Span')) {
|
|
|
185 return $flag ? $b->{$SecondsSpan} <=> $a->{$SecondsSpan} : $a->{$SecondsSpan} <=> $b->{$SecondsSpan};
|
|
|
186 } elsif (not ref $b) {
|
|
|
187 return $flag ? $b <=> $a->{$SecondsSpan} : $a->{$SecondsSpan} <=> $b;
|
|
|
188 } else {
|
|
|
189 die new Exception("Only a time span can be compared to the time span");
|
|
|
190 }
|
|
|
191 }
|
|
|
192
|
|
|
193 package DateTime::TimeLine;
|
|
|
194 use Common;
|
|
|
195 our @ISA = qw(Object);
|
|
|
196
|
|
|
197 BEGIN {
|
|
|
198 DeclareProperty Timeline => ACCESS_READ;
|
|
|
199 }
|
|
|
200
|
|
|
201 sub CTOR {
|
|
|
202 my ($this) = @_;
|
|
|
203
|
|
|
204 $this->{$Timeline} = [ {Date => undef} ];
|
|
|
205 }
|
|
|
206
|
|
|
207 # ðåêóðñèâíî êîïèðóåò ïðîñòûå ñòðóêòóðû
|
|
|
208 sub SimpleCopy {
|
|
|
209 my ($refObject,$cache) = @_;
|
|
|
210
|
|
|
211 return undef if not defined $refObject;
|
|
|
212
|
|
|
213 $cache ||= {};
|
|
|
214
|
|
|
215 if ($cache->{$refObject}) {
|
|
|
216 return $cache->{$refObject};
|
|
|
217 }
|
|
|
218
|
|
|
219 local $_;
|
|
|
220
|
|
|
221 if (ref $refObject eq 'HASH' ) {
|
|
|
222 return ($cache->{$refObject} = { map { $_, SimpleCopy($refObject->{$_},$cache) } keys %$refObject });
|
|
|
223 } elsif (ref $refObject eq 'ARRAY' ) {
|
|
|
224 return ($cache->{$refObject} = [ map { SimpleCopy($_,$cache) } @$refObject]);
|
|
|
225 } else {
|
|
|
226 return ($cache->{$refObject} = $refObject);
|
|
|
227 }
|
|
|
228 }
|
|
|
229
|
|
|
230 sub Split {
|
|
|
231 my ($this,$date) = @_;
|
|
|
232
|
|
|
233 die new Exception('Can\'t split the timeline with an undefined date') unless $date;
|
|
|
234
|
|
|
235 for (my $i = 0; $i < @{$this->{$Timeline}}; $i++) {
|
|
|
236 my $Elem = $this->{$Timeline}[$i];
|
|
|
237 if ($Elem->{Date} and $Elem->{Date} >= $date ) {
|
|
|
238 if ($Elem->{Date} == $date) {
|
|
|
239 return $Elem;
|
|
|
240 } else {
|
|
|
241 my $newElem = SimpleCopy($this->{$Timeline}[$i-1]);
|
|
|
242 $newElem->{Date} = $date;
|
|
|
243 use Data::Dumper;
|
|
|
244
|
|
|
245 splice @{$this->{$Timeline}},$i,0,$newElem;
|
|
|
246 return $newElem;
|
|
|
247 }
|
|
|
248 }
|
|
|
249 }
|
|
|
250 my $Elem = { Date => $date };
|
|
|
251 push @{$this->{$Timeline}},$Elem;
|
|
|
252 return $Elem;
|
|
|
253 }
|
|
|
254
|
|
|
255 sub Select {
|
|
|
256 my ($this,$start,$end) = @_;
|
|
|
257
|
|
|
258 my @result;
|
|
|
259
|
|
|
260 for (my $i=0; $i< @{$this->{$Timeline}}; $i++) {
|
|
|
261 my $Elem = $this->{$Timeline}[$i];
|
|
|
262 my $Next = $this->{$Timeline}[$i+1];
|
|
|
263 if (
|
|
|
264 (not $Elem->{Date} or not $start or $Elem->{Date} < $start)
|
|
|
265 and
|
|
|
266 (not $Next->{Date} or not $start or $Next->{Date} > $start)
|
|
|
267 ) {
|
|
|
268 # ------*++++(++++*----...--)---
|
|
|
269 push @result,$Elem;
|
|
|
270 } elsif (
|
|
|
271 $Elem->{Date}
|
|
|
272 and
|
|
|
273 (not $start or $Elem->{Date} >= $start)
|
|
|
274 and
|
|
|
275 (not $end or $Elem->{Date} < $end )
|
|
|
276 ) {
|
|
|
277 # ------*---(----*++...++*++)+++*----
|
|
|
278 push @result,$Elem;
|
|
|
279 } elsif ( $Elem->{Date} and $end and $Elem->{Date} >= $end) {
|
|
|
280 last;
|
|
|
281 }
|
|
|
282 }
|
|
|
283
|
|
|
284 return @result;
|
|
|
285 }
|
|
|
286
|
|
|
287 sub SelectStrict {
|
|
|
288 my ($this,$start,$end) = @_;
|
|
|
289 $this->Split($start);
|
|
|
290 $this->Split($end);
|
|
|
291 return grep {
|
|
|
292 $_->{Date}
|
|
|
293 and
|
|
|
294 $start ? $_->{Date} >= $start : 1
|
|
|
295 and
|
|
|
296 $end ? $_->{Date} < $end : 1
|
|
|
297 } @{$this->{$Timeline}};
|
|
|
298 }
|
|
|
299
|
|
|
300 sub SelectAsPeriod {
|
|
|
301 my ($this,$start,$end) = @_;
|
|
|
302
|
|
|
303 my @Dates = $this->Select($start,$end);
|
|
|
304 for (my $i = 0; $i< @Dates; $i++) {
|
|
|
305 $Dates[$i]->{Start} = $Dates[$i]->{Date};
|
|
|
306 $Dates[$i]->{End} = $Dates[$i+1] ? $Dates[$i+1]->{Date} : undef
|
|
|
307 }
|
|
|
308
|
|
|
309 return @Dates;
|
|
|
310 }
|
|
|
311
|
|
|
312 1;
|
