/[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.4 - (hide annotations)
Sun Oct 5 19:06:44 2003 UTC (20 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.3: +10 -10 lines
pod fix

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     my $s = $hh * 3600 || die("need at least hour specified for start time");
67     $s += $mm * 60 if ($mm);
68     $s += $ss if ($ss);
69     $self->{start} = $s;
70    
71     die("need end time") if (! $self->{ARGS}->{end});
72    
73     ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);
74     $s = $hh * 3600 || die("need at least hour specified for end time");
75     $s += $mm * 60 if ($mm);
76     $self->{end} = $s;
77    
78     die("need dayMask specified") if (! $self->{ARGS}->{dayMask});
79    
80     $self->{dayMask} = $self->{ARGS}->{dayMask};
81    
82     $self ? return $self : return undef;
83     }
84    
85    
86    
87     #
88     # this sub (originally from Time::Avail) will return if day is applicable
89     #
90    
91 dpavlin 1.3 sub _dayOk($) {
92     my $self = shift;
93     my $day = shift || return;
94 dpavlin 1.1
95 dpavlin 1.3 my $dayMask = $self->{dayMask};
96 dpavlin 1.1
97     my $dayOk = 0;
98    
99     if( ( $day == 0 ) && ( $dayMask & DAY_SUNDAY ) ) {
100     $dayOk = 1;
101     } elsif( ( $day == 1) && ( $dayMask & DAY_MONDAY ) ) {
102     $dayOk = 1;
103     } elsif( ($day == 2) && ( $dayMask & DAY_TUESDAY ) ) {
104     $dayOk = 1;
105     } elsif( ($day == 3) && ( $dayMask & DAY_WEDNESDAY ) ) {
106     $dayOk = 1;
107     } elsif( ( $day == 4) && ( $dayMask & DAY_THURSDAY ) ) {
108     $dayOk = 1;
109     } elsif( ( $day == 5 ) && ( $dayMask & DAY_FRIDAY ) ) {
110     $dayOk = 1;
111     } elsif( ( $day == 6 ) && ( $dayMask & DAY_SATURDAY ) ) {
112     $dayOk = 1;
113     }
114    
115     print STDERR "day: $day dayMask: ",unpack("B32", pack("N", $dayMask))," ok: $dayOk\n" if ($debug);
116    
117     return $dayOk;
118     }
119    
120    
121     #
122     # this will return number of seconds that service is available if passed
123     # uptime of service
124     #
125    
126     sub uptime {
127     my $self = shift;
128    
129     my $time = shift || die "need uptime timestamp to calcualte uptime";
130    
131 dpavlin 1.3 # calculate offset -- that is number of seconds since midnight
132     my @lt = localtime($time);
133     my $offset = $lt[2]; # hour
134     $offset *= 60; # convert to minutes
135     $offset += $lt[1]; # minutes
136     $offset *= 60; # convert to seconds
137     $offset += $lt[0];
138    
139     # check if day falls into dayMask
140     return 0 if (! $self->_dayOk($lt[6]) );
141    
142 dpavlin 1.1 my $s=0;
143    
144     my $start = $self->{start};
145     my $end = $self->{end};
146    
147 dpavlin 1.3 print STDERR "start: $start end: $end time: $offset\n" if ($debug);
148 dpavlin 1.1
149 dpavlin 1.3 if ( $end > $start ) {
150     if ($offset < $start) {
151 dpavlin 1.1 $s = $end - $start;
152 dpavlin 1.3 } elsif ($offset < $end) {
153     $s = $end - $offset;
154 dpavlin 1.1 }
155 dpavlin 1.3 } elsif ( $start > $end ) { # over midnight
156     if ( $offset < $end ) {
157     if ( $offset < $start) {
158     $s = SEC_PER_DAY - $start + $end - $offset;
159 dpavlin 1.1 } else {
160     $s = SEC_PER_DAY - $start + $end;
161     }
162     } else {
163 dpavlin 1.3 if ( $offset < $start ) {
164 dpavlin 1.1 $s = SEC_PER_DAY - $start;
165     } else {
166 dpavlin 1.3 $s = SEC_PER_DAY - $offset;
167 dpavlin 1.1 }
168     }
169     }
170    
171     return $s;
172     }
173    
174 dpavlin 1.2 #
175     # this auxillary function will pretty-format interval in [days]d hh:mm:ss
176     #
177    
178     sub fmt_interval {
179     my $s = shift || 0;
180     my $out = "";
181    
182     my $d = int($s/(24*60*60));
183     $s = $s % (24*60*60);
184     my $h = int($s/(60*60));
185     $s = $s % (60*60);
186     my $m = int($s/60);
187     $s = $s % 60;
188    
189     $out .= $d."d " if ($d > 0);
190 dpavlin 1.1
191 dpavlin 1.2 $out .= sprintf("%02d:%02d:%02d",$h,$m,$s);
192    
193     return $out;
194     }
195 dpavlin 1.1
196     1;
197     __END__
198    
199     =head1 NAME
200    
201     Time::Available - Perl extension to calculate time availability
202    
203     =head1 SYNOPSIS
204    
205     use Time::Available;
206    
207     # init interval and dayMask
208     my $interval = new( start=>'07:00', stop=>'17:00',
209     dayMask=> Time::Available::DAY_WEEKDAY );
210    
211     # alternative way to init module using exporting of days
212     use Time::Available qw(:days);
213     my $interval = new( start=>'07:00', stop=>'17:00',
214     dayMask=> DAY_WEEKDAY );
215    
216     # calculate current availability in seconds
217     print $interval->uptime(localtime);
218    
219     # calculate availablity in seconds from interval of uptime
220     print $interval->interval($utime1,$utime2);
221    
222 dpavlin 1.2 # pretty print interval data (this will produce output '1d 11:11:11')
223     use Time::Available qw(:fmt_interval);
224     print fmt_interval(126671);
225    
226 dpavlin 1.1 =head1 DESCRIPTION
227    
228     Time::Available is used to calculate availability of some resource if start
229     end end time of availability is available. That availability is calculated
230     relative to some interval which is defined when new instance of module is
231     created.
232    
233     Start and end dates must be specified in 24-hour format. You can specify
234     just hour, hour:minute or hour:minute:seconds format.
235    
236     The B<dayMask> parameter is constructed by OR'ing together one or more of
237     the following dayMask constants:
238    
239     =over 4
240    
241     =item *
242 dpavlin 1.4 Time::Available::DAY_MONDAY
243 dpavlin 1.1
244     =item *
245 dpavlin 1.4 Time::Available::DAY_TUESDAY
246 dpavlin 1.1
247     =item *
248 dpavlin 1.4 Time::Available::DAY_WEDNESDAY
249 dpavlin 1.1
250     =item *
251 dpavlin 1.4 Time::Available::DAY_THURSDAY
252 dpavlin 1.1
253     =item *
254 dpavlin 1.4 Time::Available::DAY_FRIDAY
255 dpavlin 1.1
256     =item *
257 dpavlin 1.4 Time::Available::DAY_SATURDAY
258 dpavlin 1.1
259     =item *
260 dpavlin 1.4 Time::Available::DAY_SUNDAY
261 dpavlin 1.1
262     =item *
263 dpavlin 1.4 Time::Available::DAY_WEEKDAY
264 dpavlin 1.1
265     =item *
266 dpavlin 1.4 Time::Available::DAY_WEEKEND
267 dpavlin 1.1
268     =item *
269 dpavlin 1.4 Time::Available::DAY_EVERYDAY
270 dpavlin 1.1
271     =back
272    
273     FIXME
274    
275     =head2 EXPORT
276    
277 dpavlin 1.2 None by default.
278    
279     If you specify B<:days>, Time::Available will export all
280 dpavlin 1.1 DAY_* constraints to your enviroment (causing possible pollution of name
281     space). You have been warned.
282    
283 dpavlin 1.2 With B<:fmt_interval> it will include function B<fmt_interval> which will
284     pretty-format interval into [days]d hh:mm:ss.
285    
286 dpavlin 1.1
287     =head1 HISTORY
288    
289     =over 8
290    
291     =item 0.01
292    
293     Original version; based somewhat on Time::Avail code
294    
295     =back
296    
297     =head1 BUGS
298    
299     =over 8
300    
301     =item *
302     Use croak and not die in module for better error handling
303    
304     =item *
305     Allow arbitary (array?) of holidays to be included.
306    
307     =back
308    
309     =head1 SEE ALSO
310    
311     Time::Avail is CPAN module that started it all. However, it lacked
312     calculating of availability of some interval and precision in seconds, so
313     this module was born.
314    
315     More information about this module might be found on
316 dpavlin 1.3 http://www.rot13.org/~dpavlin/projects.html#cpan
317 dpavlin 1.1
318     =head1 AUTHOR
319    
320     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
321    
322     =head1 COPYRIGHT AND LICENSE
323    
324     Copyright (C) 2003 by Dobrica Pavlinusic
325    
326     This library is free software; you can redistribute it and/or modify
327     it under the same terms as Perl itself.
328    
329     =cut
330    
331    
332     1;

  ViewVC Help
Powered by ViewVC 1.1.26