/[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.6 - (hide annotations)
Sun Oct 5 22:26:54 2003 UTC (20 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.5: +67 -9 lines
added downtime (not working yet)

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

  ViewVC Help
Powered by ViewVC 1.1.26