/[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.1.1.1 - (hide annotations) (vendor branch)
Fri Oct 3 14:19:50 2003 UTC (15 years, 8 months ago) by dpavlin
Branch: DbP
CVS Tags: r0
Changes since 1.1: +0 -0 lines
initial CVS import. not tested. If it breaks, you get to keep both peaces.

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     # Items to export into callers namespace by default. Note: do not export
12     # names by default without a very good reason. Use EXPORT_OK instead.
13     # Do not simply export all your public functions/methods/constants.
14    
15     # This allows declaration use Time::Available ':all';
16     # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
17     # will save memory.
18     our %EXPORT_TAGS = (
19     'days' => [ qw(
20     DAY_MONDAY
21     DAY_TUESDAY
22     DAY_WEDNESDAY
23     DAY_THURSDAY
24     DAY_FRIDAY
25     DAY_SATURDAY
26     DAY_SUNDAY
27     DAY_WEEKDAY
28     DAY_WEEKEND
29     DAY_EVERYDAY
30     ) ]
31     );
32    
33     our @EXPORT_OK = ( @{ $EXPORT_TAGS{'days'} } );
34    
35     our @EXPORT = qw(
36    
37     );
38    
39     our $VERSION = '0.01';
40    
41     # define some constants used later
42     use constant DAY_MONDAY => 0x01;
43     use constant DAY_TUESDAY => 0x02;
44     use constant DAY_WEDNESDAY => 0x04;
45     use constant DAY_THURSDAY => 0x08;
46     use constant DAY_FRIDAY => 0x10;
47     use constant DAY_SATURDAY => 0x20;
48     use constant DAY_SUNDAY => 0x40;
49     use constant DAY_WEEKDAY => 0x1F;
50     use constant DAY_WEEKEND => 0x60;
51     use constant DAY_EVERYDAY => 0x7F;
52    
53     use constant SEC_PER_DAY => 86400;
54    
55     my $debug = 0;
56    
57     #
58     # make new instance
59     #
60     sub new {
61     my $class = shift;
62     my $self = {};
63     bless($self, $class);
64     $self->{ARGS} = {@_};
65     $debug = $self->{ARGS}->{DEBUG};
66    
67     die("need start time") if (! $self->{ARGS}->{start});
68    
69     # calc start and stop seconds
70     my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);
71     my $s = $hh * 3600 || die("need at least hour specified for start time");
72     $s += $mm * 60 if ($mm);
73     $s += $ss if ($ss);
74     $self->{start} = $s;
75    
76     die("need end time") if (! $self->{ARGS}->{end});
77    
78     ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);
79     $s = $hh * 3600 || die("need at least hour specified for end time");
80     $s += $mm * 60 if ($mm);
81     $self->{end} = $s;
82    
83     die("need dayMask specified") if (! $self->{ARGS}->{dayMask});
84    
85     $self->{dayMask} = $self->{ARGS}->{dayMask};
86    
87     $self ? return $self : return undef;
88     }
89    
90    
91    
92     #
93     # this sub (originally from Time::Avail) will return if day is applicable
94     #
95    
96     sub _dayOk($$) {
97    
98     my( $dayMask, $day ) = @_; # get parameters
99    
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     my $time = shift || die "need uptime timestamp to calcualte uptime";
133    
134     my $s=0;
135    
136     my $start = $self->{start};
137     my $end = $self->{end};
138    
139     print STDERR "start: $start end: $end time: $time\n" if ($debug);
140    
141     if( ( $end > $start ) && ( $time < $end ) ) {
142     if ($time < $start) {
143     $s = $end - $start;
144     } else {
145     $s = $end - $time;
146     }
147     } elsif( $start > $end ) { # over midnight
148     if ( $time < $end ) {
149     if ( $time < $start) {
150     $s = SEC_PER_DAY - $start + $end - $time;
151     } else {
152     $s = SEC_PER_DAY - $start + $end;
153     }
154     } else {
155     if ( $time < $start ) {
156     $s = SEC_PER_DAY - $start;
157     } else {
158     $s = SEC_PER_DAY - $time;
159     }
160     }
161     }
162    
163     return $s;
164     }
165    
166    
167    
168     1;
169     __END__
170    
171     =head1 NAME
172    
173     Time::Available - Perl extension to calculate time availability
174    
175     =head1 SYNOPSIS
176    
177     use Time::Available;
178    
179     # init interval and dayMask
180     my $interval = new( start=>'07:00', stop=>'17:00',
181     dayMask=> Time::Available::DAY_WEEKDAY );
182    
183     # alternative way to init module using exporting of days
184     use Time::Available qw(:days);
185     my $interval = new( start=>'07:00', stop=>'17:00',
186     dayMask=> DAY_WEEKDAY );
187    
188     # calculate current availability in seconds
189     print $interval->uptime(localtime);
190    
191     # calculate availablity in seconds from interval of uptime
192     print $interval->interval($utime1,$utime2);
193    
194     =head1 DESCRIPTION
195    
196     Time::Available is used to calculate availability of some resource if start
197     end end time of availability is available. That availability is calculated
198     relative to some interval which is defined when new instance of module is
199     created.
200    
201     Start and end dates must be specified in 24-hour format. You can specify
202     just hour, hour:minute or hour:minute:seconds format.
203    
204     The B<dayMask> parameter is constructed by OR'ing together one or more of
205     the following dayMask constants:
206    
207     =over 4
208    
209     =item *
210     Time::Avail::DAY_MONDAY
211    
212     =item *
213     Time::Avail::DAY_TUESDAY
214    
215     =item *
216     Time::Avail::DAY_WEDNESDAY
217    
218     =item *
219     Time::Avail::DAY_THURSDAY
220    
221     =item *
222     Time::Avail::DAY_FRIDAY
223    
224     =item *
225     Time::Avail::DAY_SATURDAY
226    
227     =item *
228     Time::Avail::DAY_SUNDAY
229    
230     =item *
231     Time::Avail::DAY_WEEKDAY
232    
233     =item *
234     Time::Avail::DAY_WEEKEND
235    
236     =item *
237     Time::Avail::DAY_EVERYDAY
238    
239     =back
240    
241     FIXME
242    
243     =head2 EXPORT
244    
245     None by default. If you specify B<:days>, Time::Available will export all
246     DAY_* constraints to your enviroment (causing possible pollution of name
247     space). You have been warned.
248    
249    
250     =head1 HISTORY
251    
252     =over 8
253    
254     =item 0.01
255    
256     Original version; based somewhat on Time::Avail code
257    
258     =back
259    
260     =head1 BUGS
261    
262     =over 8
263    
264     =item *
265     Use croak and not die in module for better error handling
266    
267     =item *
268     Allow arbitary (array?) of holidays to be included.
269    
270     =back
271    
272     =head1 SEE ALSO
273    
274     Time::Avail is CPAN module that started it all. However, it lacked
275     calculating of availability of some interval and precision in seconds, so
276     this module was born.
277    
278     More information about this module might be found on
279     http://www.rot13.org/~dpavlin/perl.html#cpan
280    
281     =head1 AUTHOR
282    
283     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
284    
285     =head1 COPYRIGHT AND LICENSE
286    
287     Copyright (C) 2003 by Dobrica Pavlinusic
288    
289     This library is free software; you can redistribute it and/or modify
290     it under the same terms as Perl itself.
291    
292     =cut
293    
294    
295     1;

  ViewVC Help
Powered by ViewVC 1.1.26