/[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.9 - (show annotations)
Mon Oct 6 22:32:25 2003 UTC (15 years, 6 months ago) by dpavlin
Branch: MAIN
Changes since 1.8: +2 -0 lines
fix for last day calculation

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 availability in seconds
382 print $interval->uptime(localtime);
383
384 # calculate availablity in seconds from interval of uptime
385 print $interval->interval($utime1,$utime2);
386
387 # pretty print interval data (this will produce output '1d 11:11:11')
388 use Time::Available qw(:fmt_interval);
389 print fmt_interval(126671);
390
391 =head1 DESCRIPTION
392
393 Time::Available is used to calculate availability of some resource if start
394 end end time of availability is available. That availability is calculated
395 relative to some interval which is defined when new instance of module is
396 created.
397
398 Start and end dates must be specified in 24-hour format. You can specify
399 just hour, hour:minute or hour:minute:seconds format.
400
401 The B<dayMask> parameter is constructed by OR'ing together one or more of
402 the following dayMask constants:
403
404 =over 4
405
406 =item *
407 Time::Available::DAY_MONDAY
408
409 =item *
410 Time::Available::DAY_TUESDAY
411
412 =item *
413 Time::Available::DAY_WEDNESDAY
414
415 =item *
416 Time::Available::DAY_THURSDAY
417
418 =item *
419 Time::Available::DAY_FRIDAY
420
421 =item *
422 Time::Available::DAY_SATURDAY
423
424 =item *
425 Time::Available::DAY_SUNDAY
426
427 =item *
428 Time::Available::DAY_WEEKDAY
429
430 =item *
431 Time::Available::DAY_WEEKEND
432
433 =item *
434 Time::Available::DAY_EVERYDAY
435
436 =back
437
438 FIXME
439
440 =head2 EXPORT
441
442 None by default.
443
444 If you specify B<:days>, Time::Available will export all
445 DAY_* constraints to your enviroment (causing possible pollution of name
446 space). You have been warned.
447
448 With B<:fmt_interval> it will include function B<fmt_interval> which will
449 pretty-format interval into [days]d hh:mm:ss.
450
451
452 =head1 HISTORY
453
454 =over 8
455
456 =item 0.01
457
458 Original version; based somewhat on Time::Avail code
459
460 =back
461
462 =head1 BUGS
463
464 =over 8
465
466 =item *
467 Allow arbitary (array?) of holidays to be included.
468
469 =back
470
471 =head1 SEE ALSO
472
473 Time::Avail is CPAN module that started it all. However, it lacked
474 calculating of availability of some interval and precision in seconds, so
475 this module was born.
476
477 More information about this module might be found on
478 http://www.rot13.org/~dpavlin/projects.html#cpan
479
480 =head1 AUTHOR
481
482 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
483
484 =head1 COPYRIGHT AND LICENSE
485
486 Copyright (C) 2003 by Dobrica Pavlinusic
487
488 This library is free software; you can redistribute it and/or modify
489 it under the same terms as Perl itself.
490
491 =cut
492
493
494 1;

  ViewVC Help
Powered by ViewVC 1.1.26