Mercurial > pub > Impl

comparison Lib/DateTime.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
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;