/[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

Contents of /Available.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show 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 package Time::Available;
2
3 use 5.001;
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 ) ],
24 'fmt_interval' => [ qw(fmt_interval) ]
25 );
26
27 our @EXPORT_OK = (
28 @{ $EXPORT_TAGS{'days'} },
29 @{ $EXPORT_TAGS{'fmt_interval'} }
30 );
31
32 our @EXPORT; # don't export anything by default!
33
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 print STDERR "new: start time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
67 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 print STDERR "new: end time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
76 $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 sub _dayOk($) {
94 my $self = shift;
95 my $day = shift || return;
96
97 my $dayMask = $self->{dayMask};
98
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 my $time = shift || die "need uptime timestamp to calculate uptime";
132
133 # 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 my $s=0;
145
146 my $start = $self->{start};
147 my $end = $self->{end};
148
149 print STDERR "start: $start end: $end time: $offset\n" if ($debug);
150
151 if ( $end > $start ) {
152 if ($offset < $start) {
153 $s = $end - $start;
154 } elsif ($offset < $end) {
155 $s = $end - $offset;
156 }
157 } elsif ( $start > $end ) { # over midnight
158 if ( $offset < $end ) {
159 if ( $offset < $start) {
160 $s = SEC_PER_DAY - $start + $end - $offset;
161 } else {
162 $s = SEC_PER_DAY - $start + $end;
163 }
164 } else {
165 if ( $offset < $start ) {
166 $s = SEC_PER_DAY - $start;
167 } else {
168 $s = SEC_PER_DAY - $offset;
169 }
170 }
171 }
172
173 return $s;
174 }
175
176 #
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
193 $out .= sprintf("%02d:%02d:%02d",$h,$m,$s);
194
195 return $out;
196 }
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 }
267
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 # 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 =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 Time::Available::DAY_MONDAY
315
316 =item *
317 Time::Available::DAY_TUESDAY
318
319 =item *
320 Time::Available::DAY_WEDNESDAY
321
322 =item *
323 Time::Available::DAY_THURSDAY
324
325 =item *
326 Time::Available::DAY_FRIDAY
327
328 =item *
329 Time::Available::DAY_SATURDAY
330
331 =item *
332 Time::Available::DAY_SUNDAY
333
334 =item *
335 Time::Available::DAY_WEEKDAY
336
337 =item *
338 Time::Available::DAY_WEEKEND
339
340 =item *
341 Time::Available::DAY_EVERYDAY
342
343 =back
344
345 FIXME
346
347 =head2 EXPORT
348
349 None by default.
350
351 If you specify B<:days>, Time::Available will export all
352 DAY_* constraints to your enviroment (causing possible pollution of name
353 space). You have been warned.
354
355 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
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 http://www.rot13.org/~dpavlin/projects.html#cpan
389
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