/[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.5 - (hide annotations)
Sun Oct 5 20:55:19 2003 UTC (20 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.4: +73 -1 lines
implementation of interval

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     my @lt = localtime($time);
135     my $offset = $lt[2]; # hour
136     $offset *= 60; # convert to minutes
137     $offset += $lt[1]; # minutes
138     $offset *= 60; # convert to seconds
139     $offset += $lt[0];
140    
141     # check if day falls into dayMask
142     return 0 if (! $self->_dayOk($lt[6]) );
143    
144 dpavlin 1.1 my $s=0;
145    
146     my $start = $self->{start};
147     my $end = $self->{end};
148    
149 dpavlin 1.3 print STDERR "start: $start end: $end time: $offset\n" if ($debug);
150 dpavlin 1.1
151 dpavlin 1.3 if ( $end > $start ) {
152     if ($offset < $start) {
153 dpavlin 1.1 $s = $end - $start;
154 dpavlin 1.3 } elsif ($offset < $end) {
155     $s = $end - $offset;
156 dpavlin 1.1 }
157 dpavlin 1.3 } elsif ( $start > $end ) { # over midnight
158     if ( $offset < $end ) {
159     if ( $offset < $start) {
160     $s = SEC_PER_DAY - $start + $end - $offset;
161 dpavlin 1.1 } else {
162     $s = SEC_PER_DAY - $start + $end;
163     }
164     } else {
165 dpavlin 1.3 if ( $offset < $start ) {
166 dpavlin 1.1 $s = SEC_PER_DAY - $start;
167     } else {
168 dpavlin 1.3 $s = SEC_PER_DAY - $offset;
169 dpavlin 1.1 }
170     }
171     }
172    
173     return $s;
174     }
175    
176 dpavlin 1.2 #
177     # this auxillary function will pretty-format interval in [days]d hh:mm:ss
178     #
179    
180     sub fmt_interval {
181     my $s = shift || 0;
182     my $out = "";
183    
184     my $d = int($s/(24*60*60));
185     $s = $s % (24*60*60);
186     my $h = int($s/(60*60));
187     $s = $s % (60*60);
188     my $m = int($s/60);
189     $s = $s % 60;
190    
191     $out .= $d."d " if ($d > 0);
192 dpavlin 1.1
193 dpavlin 1.2 $out .= sprintf("%02d:%02d:%02d",$h,$m,$s);
194    
195     return $out;
196 dpavlin 1.5 }
197    
198     #
199     # this function will calculate uptime for some interval
200     #
201    
202     sub interval {
203     my $self = shift;
204     my $from = shift || die "need start time for interval";
205     my $to = shift || die "need end time for interval";
206    
207     print STDERR "from:\t$from\t",scalar gmtime($from),"\n" if ($debug);
208     print STDERR "to:\t$to\t",scalar gmtime($to),"\n" if ($debug);
209    
210     my $total = 0;
211    
212     # calc first day availability
213     $total += $self->uptime($from);
214    
215     print STDERR "total: $total\n" if ($debug);
216    
217     # add all whole days
218    
219     my $sec_in_day = $self->sec_in_interval;
220     my $day = 86400; # 24*60*60
221    
222     my $loop_start_time = int($from/$day)*$day + $day;
223     my $loop_end_time = int($to/$day)*$day - $day;
224    
225     print STDERR "loop (start - end): $loop_start_time - $loop_end_time\n" if ($debug);
226    
227     for (my $t = $loop_start_time; $t <= $loop_end_time; $t += $day) {
228     print STDERR "t:\t$t\t",scalar gmtime($t),"\n" if ($debug);
229     $total += $sec_in_day if ($self->day_in_interval($t));
230     print STDERR "total: $total\n" if ($debug);
231     }
232    
233     # add rest of last day
234     $total -= $self->utpime($to);
235     print STDERR "total: $total (final)\n" if ($debug);
236    
237     return $total;
238     }
239    
240     #
241     # this function will check if day falls into interval
242     #
243    
244     sub day_in_interval {
245     my $self = shift;
246    
247     my $time = shift || die "need timestamp to check if day is in interval";
248    
249     my @lt = localtime($time);
250     return $self->_dayOk($lt[6]);
251     }
252    
253     #
254     # return seconds in defined interval
255     #
256    
257     sub sec_in_interval {
258     my $self = shift;
259    
260     # over midnight?
261     if ($self->{start} > $self->{end}) {
262     return(86400 - $self->{start} + $self->{end});
263     } else {
264     return($self->{end} - $self->{start});
265     }
266 dpavlin 1.2 }
267 dpavlin 1.1
268     1;
269     __END__
270    
271     =head1 NAME
272    
273     Time::Available - Perl extension to calculate time availability
274    
275     =head1 SYNOPSIS
276    
277     use Time::Available;
278    
279     # init interval and dayMask
280     my $interval = new( start=>'07:00', stop=>'17:00',
281     dayMask=> Time::Available::DAY_WEEKDAY );
282    
283     # alternative way to init module using exporting of days
284     use Time::Available qw(:days);
285     my $interval = new( start=>'07:00', stop=>'17:00',
286     dayMask=> DAY_WEEKDAY );
287    
288     # calculate current availability in seconds
289     print $interval->uptime(localtime);
290    
291     # calculate availablity in seconds from interval of uptime
292     print $interval->interval($utime1,$utime2);
293    
294 dpavlin 1.2 # pretty print interval data (this will produce output '1d 11:11:11')
295     use Time::Available qw(:fmt_interval);
296     print fmt_interval(126671);
297    
298 dpavlin 1.1 =head1 DESCRIPTION
299    
300     Time::Available is used to calculate availability of some resource if start
301     end end time of availability is available. That availability is calculated
302     relative to some interval which is defined when new instance of module is
303     created.
304    
305     Start and end dates must be specified in 24-hour format. You can specify
306     just hour, hour:minute or hour:minute:seconds format.
307    
308     The B<dayMask> parameter is constructed by OR'ing together one or more of
309     the following dayMask constants:
310    
311     =over 4
312    
313     =item *
314 dpavlin 1.4 Time::Available::DAY_MONDAY
315 dpavlin 1.1
316     =item *
317 dpavlin 1.4 Time::Available::DAY_TUESDAY
318 dpavlin 1.1
319     =item *
320 dpavlin 1.4 Time::Available::DAY_WEDNESDAY
321 dpavlin 1.1
322     =item *
323 dpavlin 1.4 Time::Available::DAY_THURSDAY
324 dpavlin 1.1
325     =item *
326 dpavlin 1.4 Time::Available::DAY_FRIDAY
327 dpavlin 1.1
328     =item *
329 dpavlin 1.4 Time::Available::DAY_SATURDAY
330 dpavlin 1.1
331     =item *
332 dpavlin 1.4 Time::Available::DAY_SUNDAY
333 dpavlin 1.1
334     =item *
335 dpavlin 1.4 Time::Available::DAY_WEEKDAY
336 dpavlin 1.1
337     =item *
338 dpavlin 1.4 Time::Available::DAY_WEEKEND
339 dpavlin 1.1
340     =item *
341 dpavlin 1.4 Time::Available::DAY_EVERYDAY
342 dpavlin 1.1
343     =back
344    
345     FIXME
346    
347     =head2 EXPORT
348    
349 dpavlin 1.2 None by default.
350    
351     If you specify B<:days>, Time::Available will export all
352 dpavlin 1.1 DAY_* constraints to your enviroment (causing possible pollution of name
353     space). You have been warned.
354    
355 dpavlin 1.2 With B<:fmt_interval> it will include function B<fmt_interval> which will
356     pretty-format interval into [days]d hh:mm:ss.
357    
358 dpavlin 1.1
359     =head1 HISTORY
360    
361     =over 8
362    
363     =item 0.01
364    
365     Original version; based somewhat on Time::Avail code
366    
367     =back
368    
369     =head1 BUGS
370    
371     =over 8
372    
373     =item *
374     Use croak and not die in module for better error handling
375    
376     =item *
377     Allow arbitary (array?) of holidays to be included.
378    
379     =back
380    
381     =head1 SEE ALSO
382    
383     Time::Avail is CPAN module that started it all. However, it lacked
384     calculating of availability of some interval and precision in seconds, so
385     this module was born.
386    
387     More information about this module might be found on
388 dpavlin 1.3 http://www.rot13.org/~dpavlin/projects.html#cpan
389 dpavlin 1.1
390     =head1 AUTHOR
391    
392     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
393    
394     =head1 COPYRIGHT AND LICENSE
395    
396     Copyright (C) 2003 by Dobrica Pavlinusic
397    
398     This library is free software; you can redistribute it and/or modify
399     it under the same terms as Perl itself.
400    
401     =cut
402    
403    
404     1;

  ViewVC Help
Powered by ViewVC 1.1.26