/[Time-Available]/Available.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /Available.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Mon Oct 6 20:59:11 2003 UTC (15 years, 8 months ago) by dpavlin
Branch: MAIN
Changes since 1.7: +102 -70 lines
consider timezone when calculating interval

1 package Time::Available;
2
3 use 5.001;
4 use strict;
5 use warnings;
6 use Carp;
7 use Time::Local;
8
9 require Exporter;
10
11 our @ISA = qw(Exporter);
12
13 our %EXPORT_TAGS = (
14 'days' => [ qw(
15 DAY_MONDAY
16 DAY_TUESDAY
17 DAY_WEDNESDAY
18 DAY_THURSDAY
19 DAY_FRIDAY
20 DAY_SATURDAY
21 DAY_SUNDAY
22 DAY_WEEKDAY
23 DAY_WEEKEND
24 DAY_EVERYDAY
25 ) ],
26 'fmt_interval' => [ qw(fmt_interval) ]
27 );
28
29 our @EXPORT_OK = (
30 @{ $EXPORT_TAGS{'days'} },
31 @{ $EXPORT_TAGS{'fmt_interval'} }
32 );
33
34 our @EXPORT; # don't export anything by default!
35
36 our $VERSION = '0.01';
37
38 # define some constants used later
39 use constant DAY_MONDAY => 0x01;
40 use constant DAY_TUESDAY => 0x02;
41 use constant DAY_WEDNESDAY => 0x04;
42 use constant DAY_THURSDAY => 0x08;
43 use constant DAY_FRIDAY => 0x10;
44 use constant DAY_SATURDAY => 0x20;
45 use constant DAY_SUNDAY => 0x40;
46 use constant DAY_WEEKDAY => 0x1F;
47 use constant DAY_WEEKEND => 0x60;
48 use constant DAY_EVERYDAY => 0x7F;
49
50 use constant SEC_PER_DAY => 86400;
51
52 my $debug = 0;
53
54 #
55 # make new instance
56 #
57 sub new {
58 my $class = shift;
59 my $self = {};
60 bless($self, $class);
61 $self->{ARGS} = {@_};
62 $debug = $self->{ARGS}->{DEBUG};
63
64 croak("need start time") if (! $self->{ARGS}->{start});
65
66 # calc start and stop seconds
67 my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);
68 print STDERR "new: start time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
69 croak("need at least hour specified for start time") if (! $hh);
70 $mm |= 0;
71 $ss |= 0;
72 $self->{start_arr} = [$ss,$mm,$hh];
73
74 my $start = $hh;
75 $start *= 60;
76 $start += $mm;
77 $start *= 60;
78 $start += $ss;
79
80 croak("need end time") if (! $self->{ARGS}->{end});
81
82 ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);
83 print STDERR "new: end time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
84 croak("need at least hour specified for end time") if (! $hh);
85 $mm |= 0;
86 $ss |= 0;
87 $self->{end_arr} = [$ss,$mm,$hh];
88
89 my $end = $hh;
90 $end *= 60;
91 $end += $mm;
92 $end *= 60;
93 $end += $ss;
94
95 croak("need dayMask specified") if (! $self->{ARGS}->{dayMask});
96
97 $self->{dayMask} = $self->{ARGS}->{dayMask};
98
99 # over midnight?
100 if ($start > $end) {
101 $self->{sec_in_interval} = (86400 - $start + $end);
102 } else {
103 $self->{sec_in_interval} = ($end - $start);
104 }
105 $self ? return $self : return undef;
106 }
107
108 #
109 # this sub (originally from Time::Avail) will return if day is applicable
110 #
111
112 sub _dayOk($) {
113 my $self = shift;
114 my $day = shift || return;
115
116 my $dayMask = $self->{dayMask};
117
118 my $dayOk = 0;
119
120 if( ( $day == 0 ) && ( $dayMask & DAY_SUNDAY ) ) {
121 $dayOk = 1;
122 } elsif( ( $day == 1) && ( $dayMask & DAY_MONDAY ) ) {
123 $dayOk = 1;
124 } elsif( ($day == 2) && ( $dayMask & DAY_TUESDAY ) ) {
125 $dayOk = 1;
126 } elsif( ($day == 3) && ( $dayMask & DAY_WEDNESDAY ) ) {
127 $dayOk = 1;
128 } elsif( ( $day == 4) && ( $dayMask & DAY_THURSDAY ) ) {
129 $dayOk = 1;
130 } elsif( ( $day == 5 ) && ( $dayMask & DAY_FRIDAY ) ) {
131 $dayOk = 1;
132 } elsif( ( $day == 6 ) && ( $dayMask & DAY_SATURDAY ) ) {
133 $dayOk = 1;
134 }
135
136 print STDERR "day: $day dayMask: ",unpack("B32", pack("N", $dayMask))," ok: $dayOk\n" if ($debug);
137
138 return $dayOk;
139 }
140
141 #
142 # calculate start and end of interval in given day
143 #
144
145 sub _start {
146 my $self = shift;
147 my $t = shift || croak "_start needs timestap";
148
149 my @lt = localtime($t);
150 $lt[0] = $self->{start_arr}[0];
151 $lt[1] = $self->{start_arr}[1];
152 $lt[2] = $self->{start_arr}[2];
153 return timelocal(@lt);
154 }
155
156 sub _end {
157 my $self = shift;
158 my $t = shift || croak "_end needs timestap";
159
160 my @lt = localtime($t);
161 $lt[0] = $self->{end_arr}[0];
162 $lt[1] = $self->{end_arr}[1];
163 $lt[2] = $self->{end_arr}[2];
164 return timelocal(@lt);
165 }
166
167 #
168 # this will return number of seconds that service is available if passed
169 # uptime of service
170 #
171
172 sub uptime {
173 my $self = shift;
174
175 my $time = shift || croak "need uptime timestamp to calculate uptime";
176
177 # calculate offset -- that is number of seconds since midnight
178 my @lt = localtime($time);
179
180 # check if day falls into dayMask
181 return 0 if (! $self->_dayOk($lt[6]) );
182
183 my $s=0;
184
185 my $start = $self->_start($time);
186 my $end = $self->_end($time);
187
188 print STDERR "start: $start end: $end time: $time [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
189
190 if ( $end > $start ) {
191 if ($time < $start) {
192 $s = $end - $start;
193 } elsif ($time < $end) {
194 $s = $end - $time;
195 }
196 } elsif ( $start > $end ) { # over midnight
197 if ( $time < $end ) {
198 if ( $time < $start) {
199 $s = SEC_PER_DAY - $start + $end - $time;
200 } else {
201 $s = SEC_PER_DAY - $start + $end;
202 }
203 } else {
204 if ( $time < $start ) {
205 $s = SEC_PER_DAY - $start;
206 } else {
207 $s = SEC_PER_DAY - $time;
208 }
209 }
210 }
211
212 return $s;
213 }
214
215 #
216 # this will return number of seconds that service is available if passed
217 # downtime of service
218 #
219
220 sub downtime {
221 my $self = shift;
222
223 my $time = shift || croak "need downtime timestamp to calculate uptime";
224
225 # calculate offset -- that is number of seconds since midnight
226 my @lt = localtime($time);
227
228 # check if day falls into dayMask
229 return 0 if (! $self->_dayOk($lt[6]) );
230
231 my $s=0;
232
233 my $start = $self->_start($time);
234 my $end = $self->_end($time);
235
236 print STDERR "start: $start end: $end time: $time [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
237
238 if ( $end > $start ) {
239 if ($time > $start && $time <= $end) {
240 $s = $end - $time;
241 } elsif ($time < $start) {
242 $s = $end - $start;
243 }
244 } elsif ( $start > $end ) { # over midnight
245 if ( $time < $end ) {
246 if ( $time < $start) {
247 $s = $time;
248 } else {
249 $s = 0;
250 }
251 } else {
252 if ( $time < $start ) {
253 $s = SEC_PER_DAY - $end;
254 } else {
255 $s = SEC_PER_DAY - $end + $start - $time;
256 }
257 }
258 }
259
260 return $s;
261 }
262
263 #
264 # this auxillary function will pretty-format interval in [days]d hh:mm:ss
265 #
266
267 sub fmt_interval {
268 my $int = shift || 0;
269 my $out = "";
270
271 my $s=$int;
272 my $d = int($s/(24*60*60));
273 $s = $s % (24*60*60);
274 my $h = int($s/(60*60));
275 $s = $s % (60*60);
276 my $m = int($s/60);
277 $s = $s % 60;
278
279 $out .= $d."d " if ($d > 0);
280
281 if ($debug) {
282 $out .= sprintf("%02d:%02d:%02d [%d]",$h,$m,$s, $int);
283 } else {
284 $out .= sprintf("%02d:%02d:%02d",$h,$m,$s);
285 }
286
287 return $out;
288 }
289
290 #
291 # this function will calculate uptime for some interval
292 #
293
294 sub interval {
295 my $self = shift;
296 my $from = shift || croak "need start time for interval";
297 my $to = shift || croak "need end time for interval";
298
299 print STDERR "from:\t$from\t",scalar localtime($from),"\n" if ($debug);
300 print STDERR "to:\t$to\t",scalar localtime($to),"\n" if ($debug);
301
302 my $total = 0;
303
304 # calc first day availability
305 print STDERR "t:\t$from\t",scalar localtime($from),"\n" if ($debug);
306 $total += $self->uptime($from);
307
308 print STDERR "total: ",fmt_interval($total)," (first)\n" if ($debug);
309
310 # add all whole days
311
312 my $sec_in_day = $self->{sec_in_interval};
313 my $day = 86400; # 24*60*60
314
315 my $loop_start_time = int($from/$day)*$day + $day;
316 my $loop_end_time = int($to/$day)*$day;
317
318 print STDERR "loop (start - end): $loop_start_time - $loop_end_time\n" if ($debug);
319
320 for (my $t = $loop_start_time; $t < $loop_end_time; $t += $day) {
321 print STDERR "t:\t$t\t",scalar localtime($t),"\n" if ($debug);
322 $total += $sec_in_day if ($self->day_in_interval($t));
323 print STDERR "total: ",fmt_interval($total)," (loop)\n" if ($debug);
324 }
325
326 # add rest of last day
327 print STDERR "t:\t$to\t",scalar localtime($to),"\n" if ($debug);
328
329 if ($to > $self->_start($to)) {
330 if ($to <= $self->_end($to)) {
331 $total = abs($total - $self->downtime($to));
332 } elsif($self->day_in_interval($to) && $loop_start_time < $loop_end_time) {
333 $total += $sec_in_day;
334 }
335 }
336 print STDERR "total: ",fmt_interval($total)," (final)\n" if ($debug);
337
338 return $total;
339 }
340
341 #
342 # this function will check if day falls into interval
343 #
344
345 sub day_in_interval {
346 my $self = shift;
347
348 my $time = shift || croak "need timestamp to check if day is in interval";
349
350 my @lt = localtime($time);
351 return $self->_dayOk($lt[6]);
352 }
353
354 #
355 # return seconds in defined interval
356 #
357
358
359 1;
360 __END__
361
362 =head1 NAME
363
364 Time::Available - Perl extension to calculate time availability
365
366 =head1 SYNOPSIS
367
368 use Time::Available;
369
370 # init interval and dayMask
371 my $interval = new( start=>'07:00', stop=>'17:00',
372 dayMask=> Time::Available::DAY_WEEKDAY );
373
374 # alternative way to init module using exporting of days
375 use Time::Available qw(:days);
376 my $interval = new( start=>'07:00', stop=>'17:00',
377 dayMask=> DAY_WEEKDAY );
378
379 # calculate current availability in seconds
380 print $interval->uptime(localtime);
381
382 # calculate availablity in seconds from interval of uptime
383 print $interval->interval($utime1,$utime2);
384
385 # pretty print interval data (this will produce output '1d 11:11:11')
386 use Time::Available qw(:fmt_interval);
387 print fmt_interval(126671);
388
389 =head1 DESCRIPTION
390
391 Time::Available is used to calculate availability of some resource if start
392 end end time of availability is available. That availability is calculated
393 relative to some interval which is defined when new instance of module is
394 created.
395
396 Start and end dates must be specified in 24-hour format. You can specify
397 just hour, hour:minute or hour:minute:seconds format.
398
399 The B<dayMask> parameter is constructed by OR'ing together one or more of
400 the following dayMask constants:
401
402 =over 4
403
404 =item *
405 Time::Available::DAY_MONDAY
406
407 =item *
408 Time::Available::DAY_TUESDAY
409
410 =item *
411 Time::Available::DAY_WEDNESDAY
412
413 =item *
414 Time::Available::DAY_THURSDAY
415
416 =item *
417 Time::Available::DAY_FRIDAY
418
419 =item *
420 Time::Available::DAY_SATURDAY
421
422 =item *
423 Time::Available::DAY_SUNDAY
424
425 =item *
426 Time::Available::DAY_WEEKDAY
427
428 =item *
429 Time::Available::DAY_WEEKEND
430
431 =item *
432 Time::Available::DAY_EVERYDAY
433
434 =back
435
436 FIXME
437
438 =head2 EXPORT
439
440 None by default.
441
442 If you specify B<:days>, Time::Available will export all
443 DAY_* constraints to your enviroment (causing possible pollution of name
444 space). You have been warned.
445
446 With B<:fmt_interval> it will include function B<fmt_interval> which will
447 pretty-format interval into [days]d hh:mm:ss.
448
449
450 =head1 HISTORY
451
452 =over 8
453
454 =item 0.01
455
456 Original version; based somewhat on Time::Avail code
457
458 =back
459
460 =head1 BUGS
461
462 =over 8
463
464 =item *
465 Allow arbitary (array?) of holidays to be included.
466
467 =back
468
469 =head1 SEE ALSO
470
471 Time::Avail is CPAN module that started it all. However, it lacked
472 calculating of availability of some interval and precision in seconds, so
473 this module was born.
474
475 More information about this module might be found on
476 http://www.rot13.org/~dpavlin/projects.html#cpan
477
478 =head1 AUTHOR
479
480 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
481
482 =head1 COPYRIGHT AND LICENSE
483
484 Copyright (C) 2003 by Dobrica Pavlinusic
485
486 This library is free software; you can redistribute it and/or modify
487 it under the same terms as Perl itself.
488
489 =cut
490
491
492 1;

  ViewVC Help
Powered by ViewVC 1.1.26