/[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

Annotation of /Available.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations)
Sun Oct 12 19:17:29 2003 UTC (15 years, 6 months ago) by dpavlin
Branch: MAIN
Changes since 1.10: +1 -1 lines
version 0.02, test now works!

1 dpavlin 1.1 package Time::Available;
2    
3 dpavlin 1.3 use 5.001;
4 dpavlin 1.1 use strict;
5     use warnings;
6 dpavlin 1.7 use Carp;
7 dpavlin 1.8 use Time::Local;
8 dpavlin 1.1
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 dpavlin 1.2 ) ],
26     'fmt_interval' => [ qw(fmt_interval) ]
27 dpavlin 1.1 );
28    
29 dpavlin 1.2 our @EXPORT_OK = (
30     @{ $EXPORT_TAGS{'days'} },
31     @{ $EXPORT_TAGS{'fmt_interval'} }
32     );
33 dpavlin 1.1
34 dpavlin 1.2 our @EXPORT; # don't export anything by default!
35 dpavlin 1.1
36 dpavlin 1.11 our $VERSION = '0.02';
37 dpavlin 1.1
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 dpavlin 1.7 croak("need start time") if (! $self->{ARGS}->{start});
65 dpavlin 1.1
66     # calc start and stop seconds
67     my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);
68 dpavlin 1.5 print STDERR "new: start time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
69 dpavlin 1.8 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 dpavlin 1.1
80 dpavlin 1.7 croak("need end time") if (! $self->{ARGS}->{end});
81 dpavlin 1.1
82     ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);
83 dpavlin 1.5 print STDERR "new: end time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
84 dpavlin 1.8 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 dpavlin 1.1
95 dpavlin 1.7 croak("need dayMask specified") if (! $self->{ARGS}->{dayMask});
96 dpavlin 1.1
97     $self->{dayMask} = $self->{ARGS}->{dayMask};
98    
99 dpavlin 1.8 # 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 dpavlin 1.1 $self ? return $self : return undef;
106     }
107    
108     #
109     # this sub (originally from Time::Avail) will return if day is applicable
110     #
111    
112 dpavlin 1.3 sub _dayOk($) {
113     my $self = shift;
114     my $day = shift || return;
115 dpavlin 1.1
116 dpavlin 1.3 my $dayMask = $self->{dayMask};
117 dpavlin 1.1
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 dpavlin 1.8 #
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 dpavlin 1.1
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 dpavlin 1.7 my $time = shift || croak "need uptime timestamp to calculate uptime";
176 dpavlin 1.1
177 dpavlin 1.3 # calculate offset -- that is number of seconds since midnight
178 dpavlin 1.8 my @lt = localtime($time);
179 dpavlin 1.6
180     # check if day falls into dayMask
181     return 0 if (! $self->_dayOk($lt[6]) );
182    
183 dpavlin 1.1 my $s=0;
184    
185 dpavlin 1.8 my $start = $self->_start($time);
186     my $end = $self->_end($time);
187 dpavlin 1.1
188 dpavlin 1.8 print STDERR "start: $start end: $end time: $time [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
189 dpavlin 1.1
190 dpavlin 1.3 if ( $end > $start ) {
191 dpavlin 1.8 if ($time < $start) {
192 dpavlin 1.1 $s = $end - $start;
193 dpavlin 1.8 } elsif ($time < $end) {
194     $s = $end - $time;
195 dpavlin 1.1 }
196 dpavlin 1.3 } elsif ( $start > $end ) { # over midnight
197 dpavlin 1.8 if ( $time < $end ) {
198     if ( $time < $start) {
199     $s = SEC_PER_DAY - $start + $end - $time;
200 dpavlin 1.1 } else {
201     $s = SEC_PER_DAY - $start + $end;
202     }
203     } else {
204 dpavlin 1.8 if ( $time < $start ) {
205 dpavlin 1.1 $s = SEC_PER_DAY - $start;
206     } else {
207 dpavlin 1.8 $s = SEC_PER_DAY - $time;
208 dpavlin 1.1 }
209     }
210     }
211    
212     return $s;
213     }
214    
215 dpavlin 1.2 #
216 dpavlin 1.6 # 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 dpavlin 1.7 my $time = shift || croak "need downtime timestamp to calculate uptime";
224 dpavlin 1.6
225     # calculate offset -- that is number of seconds since midnight
226 dpavlin 1.8 my @lt = localtime($time);
227 dpavlin 1.6
228     # check if day falls into dayMask
229     return 0 if (! $self->_dayOk($lt[6]) );
230    
231     my $s=0;
232    
233 dpavlin 1.8 my $start = $self->_start($time);
234     my $end = $self->_end($time);
235 dpavlin 1.6
236 dpavlin 1.8 print STDERR "start: $start end: $end time: $time [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
237 dpavlin 1.6
238     if ( $end > $start ) {
239 dpavlin 1.8 if ($time > $start && $time <= $end) {
240     $s = $end - $time;
241     } elsif ($time < $start) {
242 dpavlin 1.6 $s = $end - $start;
243     }
244     } elsif ( $start > $end ) { # over midnight
245 dpavlin 1.8 if ( $time < $end ) {
246     if ( $time < $start) {
247     $s = $time;
248 dpavlin 1.6 } else {
249     $s = 0;
250     }
251     } else {
252 dpavlin 1.8 if ( $time < $start ) {
253 dpavlin 1.6 $s = SEC_PER_DAY - $end;
254     } else {
255 dpavlin 1.8 $s = SEC_PER_DAY - $end + $start - $time;
256 dpavlin 1.6 }
257     }
258     }
259    
260     return $s;
261     }
262    
263     #
264 dpavlin 1.2 # this auxillary function will pretty-format interval in [days]d hh:mm:ss
265     #
266    
267     sub fmt_interval {
268 dpavlin 1.8 my $int = shift || 0;
269 dpavlin 1.2 my $out = "";
270    
271 dpavlin 1.8 my $s=$int;
272 dpavlin 1.2 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 dpavlin 1.1
281 dpavlin 1.8 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 dpavlin 1.2
287     return $out;
288 dpavlin 1.5 }
289    
290     #
291     # this function will calculate uptime for some interval
292     #
293    
294     sub interval {
295     my $self = shift;
296 dpavlin 1.7 my $from = shift || croak "need start time for interval";
297     my $to = shift || croak "need end time for interval";
298 dpavlin 1.5
299 dpavlin 1.8 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 dpavlin 1.5
302     my $total = 0;
303    
304     # calc first day availability
305 dpavlin 1.8 print STDERR "t:\t$from\t",scalar localtime($from),"\n" if ($debug);
306 dpavlin 1.5 $total += $self->uptime($from);
307    
308 dpavlin 1.8 print STDERR "total: ",fmt_interval($total)," (first)\n" if ($debug);
309 dpavlin 1.5
310     # add all whole days
311    
312 dpavlin 1.8 my $sec_in_day = $self->{sec_in_interval};
313 dpavlin 1.5 my $day = 86400; # 24*60*60
314    
315     my $loop_start_time = int($from/$day)*$day + $day;
316 dpavlin 1.8 my $loop_end_time = int($to/$day)*$day;
317 dpavlin 1.5
318     print STDERR "loop (start - end): $loop_start_time - $loop_end_time\n" if ($debug);
319    
320 dpavlin 1.8 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 dpavlin 1.5 $total += $sec_in_day if ($self->day_in_interval($t));
323 dpavlin 1.8 print STDERR "total: ",fmt_interval($total)," (loop)\n" if ($debug);
324 dpavlin 1.5 }
325    
326     # add rest of last day
327 dpavlin 1.8 print STDERR "t:\t$to\t",scalar localtime($to),"\n" if ($debug);
328 dpavlin 1.6
329 dpavlin 1.8 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 dpavlin 1.9 } else {
336     $total = abs($total - $self->downtime($to));
337 dpavlin 1.8 }
338     print STDERR "total: ",fmt_interval($total)," (final)\n" if ($debug);
339 dpavlin 1.5
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 dpavlin 1.7 my $time = shift || croak "need timestamp to check if day is in interval";
351 dpavlin 1.5
352 dpavlin 1.8 my @lt = localtime($time);
353 dpavlin 1.5 return $self->_dayOk($lt[6]);
354     }
355    
356     #
357     # return seconds in defined interval
358     #
359    
360 dpavlin 1.1
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 dpavlin 1.10 # calculate current uptime availability from now in seconds
382 dpavlin 1.1 print $interval->uptime(localtime);
383    
384 dpavlin 1.10 # calculate maximum downtime in seconds from current moment
385     print $interval->downtime(localtime);
386    
387 dpavlin 1.1 # calculate availablity in seconds from interval of uptime
388     print $interval->interval($utime1,$utime2);
389    
390 dpavlin 1.2 # 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 dpavlin 1.1 =head1 DESCRIPTION
395    
396     Time::Available is used to calculate availability of some resource if start
397 dpavlin 1.10 and end time of availability is supplied. Availability is calculated
398 dpavlin 1.1 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 dpavlin 1.10 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 dpavlin 1.1
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 dpavlin 1.4 Time::Available::DAY_MONDAY
416 dpavlin 1.1
417     =item *
418 dpavlin 1.4 Time::Available::DAY_TUESDAY
419 dpavlin 1.1
420     =item *
421 dpavlin 1.4 Time::Available::DAY_WEDNESDAY
422 dpavlin 1.1
423     =item *
424 dpavlin 1.4 Time::Available::DAY_THURSDAY
425 dpavlin 1.1
426     =item *
427 dpavlin 1.4 Time::Available::DAY_FRIDAY
428 dpavlin 1.1
429     =item *
430 dpavlin 1.4 Time::Available::DAY_SATURDAY
431 dpavlin 1.1
432     =item *
433 dpavlin 1.4 Time::Available::DAY_SUNDAY
434 dpavlin 1.1
435     =item *
436 dpavlin 1.4 Time::Available::DAY_WEEKDAY
437 dpavlin 1.1
438     =item *
439 dpavlin 1.4 Time::Available::DAY_WEEKEND
440 dpavlin 1.1
441     =item *
442 dpavlin 1.4 Time::Available::DAY_EVERYDAY
443 dpavlin 1.1
444     =back
445    
446 dpavlin 1.10 They should be self-explainatory.
447 dpavlin 1.1
448     =head2 EXPORT
449    
450 dpavlin 1.2 None by default.
451    
452     If you specify B<:days>, Time::Available will export all
453 dpavlin 1.1 DAY_* constraints to your enviroment (causing possible pollution of name
454     space). You have been warned.
455    
456 dpavlin 1.2 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 dpavlin 1.1
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 dpavlin 1.10 L<Time::Avail> is CPAN module that started it all. However, it lacked
482 dpavlin 1.1 calculating of availability of some interval and precision in seconds, so
483 dpavlin 1.10 this module was born. It also had some bugs in dayMask which where reported
484     to author, but his e-mail address bounced.
485 dpavlin 1.1
486     More information about this module might be found on
487 dpavlin 1.3 http://www.rot13.org/~dpavlin/projects.html#cpan
488 dpavlin 1.1
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