/[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.2 - (hide annotations)
Fri Oct 3 15:23:46 2003 UTC (20 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.1: +37 -13 lines
added fmt_interval function which pretty-print interval data

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

  ViewVC Help
Powered by ViewVC 1.1.26