/[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.10 - (show annotations)
Wed Oct 8 19:23:31 2003 UTC (15 years, 6 months ago) by dpavlin
Branch: MAIN
CVS Tags: r0_0_1
Changes since 1.9: +15 -6 lines
better documentation

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 } else {
336 $total = abs($total - $self->downtime($to));
337 }
338 print STDERR "total: ",fmt_interval($total)," (final)\n" if ($debug);
339
340 return $total;
341 }
342
343 #
344 # this function will check if day falls into interval
345 #
346
347 sub day_in_interval {
348 my $self = shift;
349
350 my $time = shift || croak "need timestamp to check if day is in interval";
351
352 my @lt = localtime($time);
353 return $self->_dayOk($lt[6]);
354 }
355
356 #
357 # return seconds in defined interval
358 #
359
360
361 1;
362 __END__
363
364 =head1 NAME
365
366 Time::Available - Perl extension to calculate time availability
367
368 =head1 SYNOPSIS
369
370 use Time::Available;
371
372 # init interval and dayMask
373 my $interval = new( start=>'07:00', stop=>'17:00',
374 dayMask=> Time::Available::DAY_WEEKDAY );
375
376 # alternative way to init module using exporting of days
377 use Time::Available qw(:days);
378 my $interval = new( start=>'07:00', stop=>'17:00',
379 dayMask=> DAY_WEEKDAY );
380
381 # calculate current uptime availability from now in seconds
382 print $interval->uptime(localtime);
383
384 # calculate maximum downtime in seconds from current moment
385 print $interval->downtime(localtime);
386
387 # calculate availablity in seconds from interval of uptime
388 print $interval->interval($utime1,$utime2);
389
390 # pretty print interval data (this will produce output '1d 11:11:11')
391 use Time::Available qw(:fmt_interval);
392 print fmt_interval(126671);
393
394 =head1 DESCRIPTION
395
396 Time::Available is used to calculate availability of some resource if start
397 and end time of availability is supplied. Availability is calculated
398 relative to some interval which is defined when new instance of module is
399 created.
400
401 Start and end dates must be specified in 24-hour format. You can specify
402 just hour, hour:minute or hour:minute:seconds format. Start and end time is
403 specified in your B<local time zone>. Timestamp, are specified in unix
404 utime, and module will take care of recalculating (using C<localtime> and
405 C<timelocal> when needed). There is one small canvat here: module is assuing
406 that time you are specifing is in same time zone in which your module is
407 running (that is from local system).
408
409 The B<dayMask> parameter is constructed by OR'ing together one or more of
410 the following dayMask constants:
411
412 =over 4
413
414 =item *
415 Time::Available::DAY_MONDAY
416
417 =item *
418 Time::Available::DAY_TUESDAY
419
420 =item *
421 Time::Available::DAY_WEDNESDAY
422
423 =item *
424 Time::Available::DAY_THURSDAY
425
426 =item *
427 Time::Available::DAY_FRIDAY
428
429 =item *
430 Time::Available::DAY_SATURDAY
431
432 =item *
433 Time::Available::DAY_SUNDAY
434
435 =item *
436 Time::Available::DAY_WEEKDAY
437
438 =item *
439 Time::Available::DAY_WEEKEND
440
441 =item *
442 Time::Available::DAY_EVERYDAY
443
444 =back
445
446 They should be self-explainatory.
447
448 =head2 EXPORT
449
450 None by default.
451
452 If you specify B<:days>, Time::Available will export all
453 DAY_* constraints to your enviroment (causing possible pollution of name
454 space). You have been warned.
455
456 With B<:fmt_interval> it will include function B<fmt_interval> which will
457 pretty-format interval into [days]d hh:mm:ss.
458
459
460 =head1 HISTORY
461
462 =over 8
463
464 =item 0.01
465
466 Original version; based somewhat on Time::Avail code
467
468 =back
469
470 =head1 BUGS
471
472 =over 8
473
474 =item *
475 Allow arbitary (array?) of holidays to be included.
476
477 =back
478
479 =head1 SEE ALSO
480
481 L<Time::Avail> is CPAN module that started it all. However, it lacked
482 calculating of availability of some interval and precision in seconds, so
483 this module was born. It also had some bugs in dayMask which where reported
484 to author, but his e-mail address bounced.
485
486 More information about this module might be found on
487 http://www.rot13.org/~dpavlin/projects.html#cpan
488
489 =head1 AUTHOR
490
491 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
492
493 =head1 COPYRIGHT AND LICENSE
494
495 Copyright (C) 2003 by Dobrica Pavlinusic
496
497 This library is free software; you can redistribute it and/or modify
498 it under the same terms as Perl itself.
499
500 =cut
501
502
503 1;

  ViewVC Help
Powered by ViewVC 1.1.26