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

Diff of /Available.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by dpavlin, Fri Oct 3 14:19:50 2003 UTC revision 1.9 by dpavlin, Mon Oct 6 22:32:25 2003 UTC
# Line 1  Line 1 
1  package Time::Available;  package Time::Available;
2    
3  use 5.008001;  use 5.001;
4  use strict;  use strict;
5  use warnings;  use warnings;
6    use Carp;
7    use Time::Local;
8    
9  require Exporter;  require Exporter;
10    
11  our @ISA = qw(Exporter);  our @ISA = qw(Exporter);
12    
 # Items to export into callers namespace by default. Note: do not export  
 # names by default without a very good reason. Use EXPORT_OK instead.  
 # Do not simply export all your public functions/methods/constants.  
   
 # This allows declaration       use Time::Available ':all';  
 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK  
 # will save memory.  
13  our %EXPORT_TAGS = (  our %EXPORT_TAGS = (
14          'days' => [ qw(          'days' => [ qw(
15                  DAY_MONDAY                  DAY_MONDAY
# Line 27  our %EXPORT_TAGS = ( Line 22  our %EXPORT_TAGS = (
22                  DAY_WEEKDAY                  DAY_WEEKDAY
23                  DAY_WEEKEND                  DAY_WEEKEND
24                  DAY_EVERYDAY                  DAY_EVERYDAY
25          ) ]          ) ],
26            'fmt_interval' => [ qw(fmt_interval) ]
27  );  );
28    
29  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'days'} } );  our @EXPORT_OK = (
30            @{ $EXPORT_TAGS{'days'} },
31            @{ $EXPORT_TAGS{'fmt_interval'} }
32            );
33    
34  our @EXPORT = qw(  our @EXPORT;    # don't export anything by default!
           
 );  
35    
36  our $VERSION = '0.01';  our $VERSION = '0.01';
37    
# Line 64  sub new { Line 61  sub new {
61          $self->{ARGS} = {@_};          $self->{ARGS} = {@_};
62          $debug = $self->{ARGS}->{DEBUG};          $debug = $self->{ARGS}->{DEBUG};
63    
64          die("need start time") if (! $self->{ARGS}->{start});          croak("need start time") if (! $self->{ARGS}->{start});
65    
66          # calc start and stop seconds          # calc start and stop seconds
67          my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);          my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);
68          my $s = $hh * 3600 || die("need at least hour specified for start time");          print STDERR "new: start time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
69          $s += $mm * 60 if ($mm);          croak("need at least hour specified for start time") if (! $hh);
70          $s += $ss if ($ss);          $mm |= 0;
71          $self->{start} = $s;          $ss |= 0;
72            $self->{start_arr} = [$ss,$mm,$hh];
73    
74            my $start = $hh;
75            $start *= 60;
76            $start += $mm;
77            $start *= 60;
78            $start += $ss;
79    
80          die("need end time") if (! $self->{ARGS}->{end});          croak("need end time") if (! $self->{ARGS}->{end});
81    
82          ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);          ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);
83          $s = $hh * 3600 || die("need at least hour specified for end time");          print STDERR "new: end time ",$hh||0,":",$mm||0,":",$ss||0,"\n" if ($debug);
84          $s += $mm * 60 if ($mm);          croak("need at least hour specified for end time") if (! $hh);
85          $self->{end} = $s;          $mm |= 0;
86            $ss |= 0;
87            $self->{end_arr} = [$ss,$mm,$hh];
88    
89            my $end = $hh;
90            $end *= 60;
91            $end += $mm;
92            $end *= 60;
93            $end += $ss;
94    
95          die("need dayMask specified") if (! $self->{ARGS}->{dayMask});          croak("need dayMask specified") if (! $self->{ARGS}->{dayMask});
96    
97          $self->{dayMask} = $self->{ARGS}->{dayMask};          $self->{dayMask} = $self->{ARGS}->{dayMask};
98    
99            # over midnight?
100            if ($start > $end) {
101                    $self->{sec_in_interval} = (86400 - $start + $end);
102            } else {
103                    $self->{sec_in_interval} = ($end - $start);
104            }
105          $self ? return $self : return undef;          $self ? return $self : return undef;
106  }  }
107    
   
   
108  #  #
109  # this sub (originally from Time::Avail) will return if day is applicable  # this sub (originally from Time::Avail) will return if day is applicable
110  #  #
111    
112  sub _dayOk($$) {  sub _dayOk($) {
113            my $self = shift;
114            my $day = shift || return;
115    
116          my( $dayMask, $day ) = @_;      # get parameters          my $dayMask = $self->{dayMask};
117    
118          my $dayOk = 0;          my $dayOk = 0;
119    
# Line 120  sub _dayOk($$) { Line 138  sub _dayOk($$) {
138          return $dayOk;          return $dayOk;
139  }  }
140    
141    #
142    # calculate start and end of interval in given day
143    #
144    
145    sub _start {
146            my $self = shift;
147            my $t = shift || croak "_start needs timestap";
148    
149            my @lt = localtime($t);
150            $lt[0] = $self->{start_arr}[0];
151            $lt[1] = $self->{start_arr}[1];
152            $lt[2] = $self->{start_arr}[2];
153            return timelocal(@lt);
154    }
155    
156    sub _end {
157            my $self = shift;
158            my $t = shift || croak "_end needs timestap";
159    
160            my @lt = localtime($t);
161            $lt[0] = $self->{end_arr}[0];
162            $lt[1] = $self->{end_arr}[1];
163            $lt[2] = $self->{end_arr}[2];
164            return timelocal(@lt);
165    }
166    
167  #  #
168  # this will return number of seconds that service is available if passed  # this will return number of seconds that service is available if passed
# Line 129  sub _dayOk($$) { Line 172  sub _dayOk($$) {
172  sub uptime {  sub uptime {
173          my $self = shift;          my $self = shift;
174    
175          my $time = shift || die "need uptime timestamp to calcualte uptime";          my $time = shift || croak "need uptime timestamp to calculate uptime";
176    
177            # calculate offset -- that is number of seconds since midnight
178            my @lt = localtime($time);
179    
180            # check if day falls into dayMask
181            return 0 if (! $self->_dayOk($lt[6]) );
182    
183          my $s=0;          my $s=0;
184    
185          my $start = $self->{start};          my $start = $self->_start($time);
186          my $end = $self->{end};          my $end = $self->_end($time);
187    
188          print STDERR "start: $start end: $end time: $time\n" if ($debug);          print STDERR "start: $start end: $end time: $time [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
189    
190          if( ( $end > $start ) && ( $time < $end ) ) {          if ( $end > $start ) {
191                  if ($time < $start) {                  if ($time < $start) {
192                          $s = $end - $start;                          $s = $end - $start;
193                  } else {                  } elsif ($time < $end) {
194                          $s = $end - $time;                          $s = $end - $time;
195                  }                  }
196          } elsif( $start > $end ) {      # over midnight          } elsif ( $start > $end ) {     # over midnight
197                  if ( $time < $end ) {                  if ( $time < $end ) {
198                          if ( $time < $start) {                          if ( $time < $start) {
199                                  $s = SEC_PER_DAY - $start + $end - $time;                                  $s = SEC_PER_DAY - $start + $end - $time;
# Line 163  sub uptime { Line 212  sub uptime {
212          return $s;          return $s;
213  }  }
214    
215    #
216    # this will return number of seconds that service is available if passed
217    # downtime of service
218    #
219    
220    sub downtime {
221            my $self = shift;
222    
223            my $time = shift || croak "need downtime timestamp to calculate uptime";
224    
225            # calculate offset -- that is number of seconds since midnight
226            my @lt = localtime($time);
227    
228            # check if day falls into dayMask
229            return 0 if (! $self->_dayOk($lt[6]) );
230    
231            my $s=0;
232    
233            my $start = $self->_start($time);
234            my $end = $self->_end($time);
235    
236            print STDERR "start: $start end: $end time: $time [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
237    
238            if ( $end > $start ) {
239                    if ($time > $start && $time <= $end) {
240                            $s = $end - $time;
241                    } elsif ($time < $start) {
242                            $s = $end - $start;
243                    }
244            } elsif ( $start > $end ) {     # over midnight
245                    if ( $time < $end ) {
246                            if ( $time < $start) {
247                                    $s = $time;
248                            } else {
249                                    $s = 0;
250                            }
251                    } else {
252                            if ( $time < $start ) {
253                                    $s = SEC_PER_DAY - $end;
254                            } else {
255                                    $s = SEC_PER_DAY - $end + $start - $time;
256                            }
257                    }
258            }
259                    
260            return $s;
261    }
262    
263    #
264    # this auxillary function will pretty-format interval in [days]d hh:mm:ss
265    #
266    
267    sub fmt_interval {
268            my $int = shift || 0;
269            my $out = "";
270    
271            my $s=$int;
272            my $d = int($s/(24*60*60));
273            $s = $s % (24*60*60);
274            my $h = int($s/(60*60));
275            $s = $s % (60*60);
276            my $m = int($s/60);
277            $s = $s % 60;
278            
279            $out .= $d."d " if ($d > 0);
280    
281            if ($debug) {
282                    $out .= sprintf("%02d:%02d:%02d [%d]",$h,$m,$s, $int);
283            } else {
284                    $out .= sprintf("%02d:%02d:%02d",$h,$m,$s);
285            }
286    
287            return $out;
288    }
289    
290    #
291    # this function will calculate uptime for some interval
292    #
293    
294    sub interval {
295            my $self = shift;
296            my $from = shift || croak "need start time for interval";
297            my $to = shift || croak "need end time for interval";
298    
299            print STDERR "from:\t$from\t",scalar localtime($from),"\n" if ($debug);
300            print STDERR "to:\t$to\t",scalar localtime($to),"\n" if ($debug);
301    
302            my $total = 0;
303    
304            # calc first day availability
305            print STDERR "t:\t$from\t",scalar localtime($from),"\n" if ($debug);
306            $total += $self->uptime($from);
307    
308            print STDERR "total: ",fmt_interval($total)," (first)\n" if ($debug);
309    
310            # add all whole days
311    
312            my $sec_in_day = $self->{sec_in_interval};
313            my $day = 86400;        # 24*60*60
314    
315            my $loop_start_time = int($from/$day)*$day + $day;
316            my $loop_end_time = int($to/$day)*$day;
317    
318            print STDERR "loop (start - end): $loop_start_time - $loop_end_time\n" if ($debug);
319    
320            for (my $t = $loop_start_time; $t < $loop_end_time; $t += $day) {
321                    print STDERR "t:\t$t\t",scalar localtime($t),"\n" if ($debug);
322                    $total += $sec_in_day if ($self->day_in_interval($t));
323                    print STDERR "total: ",fmt_interval($total)," (loop)\n" if ($debug);
324            }
325    
326            # add rest of last day
327            print STDERR "t:\t$to\t",scalar localtime($to),"\n" if ($debug);
328    
329            if ($to > $self->_start($to)) {
330                    if ($to <= $self->_end($to)) {
331                            $total = abs($total - $self->downtime($to));
332                    } elsif($self->day_in_interval($to) && $loop_start_time < $loop_end_time) {
333                            $total += $sec_in_day;
334                    }
335            } else {
336                    $total = abs($total - $self->downtime($to));
337            }
338            print STDERR "total: ",fmt_interval($total)," (final)\n" if ($debug);
339    
340            return $total;
341    }
342    
343    #
344    # this function will check if day falls into interval
345    #
346    
347    sub day_in_interval {
348            my $self = shift;
349    
350            my $time = shift || croak "need timestamp to check if day is in interval";
351    
352            my @lt = localtime($time);
353            return $self->_dayOk($lt[6]);
354    }
355    
356    #
357    # return seconds in defined interval
358    #
359    
360    
361  1;  1;
# Line 191  Time::Available - Perl extension to calc Line 384  Time::Available - Perl extension to calc
384    # calculate availablity in seconds from interval of uptime    # calculate availablity in seconds from interval of uptime
385    print $interval->interval($utime1,$utime2);    print $interval->interval($utime1,$utime2);
386    
387      # pretty print interval data (this will produce output '1d 11:11:11')
388      use Time::Available qw(:fmt_interval);
389      print fmt_interval(126671);
390    
391  =head1 DESCRIPTION  =head1 DESCRIPTION
392    
393  Time::Available is used to calculate availability of some resource if start  Time::Available is used to calculate availability of some resource if start
# Line 207  the following dayMask constants: Line 404  the following dayMask constants:
404  =over 4  =over 4
405    
406  =item *  =item *
407  Time::Avail::DAY_MONDAY  Time::Available::DAY_MONDAY
408    
409  =item *  =item *
410  Time::Avail::DAY_TUESDAY  Time::Available::DAY_TUESDAY
411    
412  =item *  =item *
413  Time::Avail::DAY_WEDNESDAY  Time::Available::DAY_WEDNESDAY
414    
415  =item *  =item *
416  Time::Avail::DAY_THURSDAY  Time::Available::DAY_THURSDAY
417    
418  =item *  =item *
419  Time::Avail::DAY_FRIDAY  Time::Available::DAY_FRIDAY
420    
421  =item *  =item *
422  Time::Avail::DAY_SATURDAY  Time::Available::DAY_SATURDAY
423    
424  =item *  =item *
425  Time::Avail::DAY_SUNDAY  Time::Available::DAY_SUNDAY
426    
427  =item *  =item *
428  Time::Avail::DAY_WEEKDAY  Time::Available::DAY_WEEKDAY
429    
430  =item *  =item *
431  Time::Avail::DAY_WEEKEND  Time::Available::DAY_WEEKEND
432    
433  =item *  =item *
434  Time::Avail::DAY_EVERYDAY  Time::Available::DAY_EVERYDAY
435    
436  =back  =back
437    
# Line 242  FIXME Line 439  FIXME
439    
440  =head2 EXPORT  =head2 EXPORT
441    
442  None by default. If you specify B<:days>, Time::Available will export all  None by default.
443    
444    If you specify B<:days>, Time::Available will export all
445  DAY_* constraints to your enviroment (causing possible pollution of name  DAY_* constraints to your enviroment (causing possible pollution of name
446  space). You have been warned.  space). You have been warned.
447    
448    With B<:fmt_interval> it will include function B<fmt_interval> which will
449    pretty-format interval into [days]d hh:mm:ss.
450    
451    
452  =head1 HISTORY  =head1 HISTORY
453    
# Line 262  Original version; based somewhat on Time Line 464  Original version; based somewhat on Time
464  =over 8  =over 8
465    
466  =item *  =item *
 Use croak and not die in module for better error handling  
   
 =item *  
467  Allow arbitary (array?) of holidays to be included.  Allow arbitary (array?) of holidays to be included.
468    
469  =back  =back
# Line 276  calculating of availability of some inte Line 475  calculating of availability of some inte
475  this module was born.  this module was born.
476    
477  More information about this module might be found on  More information about this module might be found on
478  http://www.rot13.org/~dpavlin/perl.html#cpan  http://www.rot13.org/~dpavlin/projects.html#cpan
479    
480  =head1 AUTHOR  =head1 AUTHOR
481    
Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.26