/[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.7 - (hide annotations)
Mon Oct 6 09:40:52 2003 UTC (15 years, 6 months ago) by dpavlin
Branch: MAIN
Changes since 1.6: +12 -14 lines
fix interval to work, add croak instead of die

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

  ViewVC Help
Powered by ViewVC 1.1.26