/[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.7 by dpavlin, Mon Oct 6 09:40:52 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    
8  require Exporter;  require Exporter;
9    
10  our @ISA = qw(Exporter);  our @ISA = qw(Exporter);
11    
 # 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.  
12  our %EXPORT_TAGS = (  our %EXPORT_TAGS = (
13          'days' => [ qw(          'days' => [ qw(
14                  DAY_MONDAY                  DAY_MONDAY
# Line 27  our %EXPORT_TAGS = ( Line 21  our %EXPORT_TAGS = (
21                  DAY_WEEKDAY                  DAY_WEEKDAY
22                  DAY_WEEKEND                  DAY_WEEKEND
23                  DAY_EVERYDAY                  DAY_EVERYDAY
24          ) ]          ) ],
25            'fmt_interval' => [ qw(fmt_interval) ]
26  );  );
27    
28  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'days'} } );  our @EXPORT_OK = (
29            @{ $EXPORT_TAGS{'days'} },
30            @{ $EXPORT_TAGS{'fmt_interval'} }
31            );
32    
33  our @EXPORT = qw(  our @EXPORT;    # don't export anything by default!
           
 );  
34    
35  our $VERSION = '0.01';  our $VERSION = '0.01';
36    
# Line 64  sub new { Line 60  sub new {
60          $self->{ARGS} = {@_};          $self->{ARGS} = {@_};
61          $debug = $self->{ARGS}->{DEBUG};          $debug = $self->{ARGS}->{DEBUG};
62    
63          die("need start time") if (! $self->{ARGS}->{start});          croak("need start time") if (! $self->{ARGS}->{start});
64    
65          # calc start and stop seconds          # calc start and stop seconds
66          my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);          my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);
67          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);
68            my $s = $hh * 3600 || croak("need at least hour specified for start time");
69          $s += $mm * 60 if ($mm);          $s += $mm * 60 if ($mm);
70          $s += $ss if ($ss);          $s += $ss if ($ss);
71          $self->{start} = $s;          $self->{start} = $s;
72    
73          die("need end time") if (! $self->{ARGS}->{end});          croak("need end time") if (! $self->{ARGS}->{end});
74    
75          ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);          ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);
76          $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);
77            $s = $hh * 3600 || croak("need at least hour specified for end time");
78          $s += $mm * 60 if ($mm);          $s += $mm * 60 if ($mm);
79          $self->{end} = $s;          $self->{end} = $s;
80    
81          die("need dayMask specified") if (! $self->{ARGS}->{dayMask});          croak("need dayMask specified") if (! $self->{ARGS}->{dayMask});
82    
83          $self->{dayMask} = $self->{ARGS}->{dayMask};          $self->{dayMask} = $self->{ARGS}->{dayMask};
84    
# Line 93  sub new { Line 91  sub new {
91  # this sub (originally from Time::Avail) will return if day is applicable  # this sub (originally from Time::Avail) will return if day is applicable
92  #  #
93    
94  sub _dayOk($$) {  sub _dayOk($) {
95            my $self = shift;
96            my $day = shift || return;
97    
98          my( $dayMask, $day ) = @_;      # get parameters          my $dayMask = $self->{dayMask};
99    
100          my $dayOk = 0;          my $dayOk = 0;
101    
# Line 129  sub _dayOk($$) { Line 129  sub _dayOk($$) {
129  sub uptime {  sub uptime {
130          my $self = shift;          my $self = shift;
131    
132          my $time = shift || die "need uptime timestamp to calcualte uptime";          my $time = shift || croak "need uptime timestamp to calculate uptime";
133    
134            # calculate offset -- that is number of seconds since midnight
135            my @lt = gmtime($time);
136    
137            # check if day falls into dayMask
138            return 0 if (! $self->_dayOk($lt[6]) );
139    
140            my $offset = $lt[2];    # hour
141            $offset *= 60;          # convert to minutes
142            $offset += $lt[1];      # minutes
143            $offset *= 60;          # convert to seconds
144            $offset += $lt[0];
145    
146          my $s=0;          my $s=0;
147    
148          my $start = $self->{start};          my $start = $self->{start};
149          my $end = $self->{end};          my $end = $self->{end};
150    
151          print STDERR "start: $start end: $end time: $time\n" if ($debug);          print STDERR "start: $start end: $end time: $offset [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
152    
153          if( ( $end > $start ) && ( $time < $end ) ) {          if ( $end > $start ) {
154                  if ($time < $start) {                  if ($offset < $start) {
155                          $s = $end - $start;                          $s = $end - $start;
156                  } else {                  } elsif ($offset < $end) {
157                          $s = $end - $time;                          $s = $end - $offset;
158                  }                  }
159          } elsif( $start > $end ) {      # over midnight          } elsif ( $start > $end ) {     # over midnight
160                  if ( $time < $end ) {                  if ( $offset < $end ) {
161                          if ( $time < $start) {                          if ( $offset < $start) {
162                                  $s = SEC_PER_DAY - $start + $end - $time;                                  $s = SEC_PER_DAY - $start + $end - $offset;
163                          } else {                          } else {
164                                  $s = SEC_PER_DAY - $start + $end;                                  $s = SEC_PER_DAY - $start + $end;
165                          }                          }
166                  } else {                  } else {
167                          if ( $time < $start ) {                          if ( $offset < $start ) {
168                                  $s = SEC_PER_DAY - $start;                                  $s = SEC_PER_DAY - $start;
169                          } else {                          } else {
170                                  $s = SEC_PER_DAY - $time;                                  $s = SEC_PER_DAY - $offset;
171                          }                          }
172                  }                  }
173          }          }
# Line 163  sub uptime { Line 175  sub uptime {
175          return $s;          return $s;
176  }  }
177    
178    #
179    # this will return number of seconds that service is available if passed
180    # downtime of service
181    #
182    
183    sub downtime {
184            my $self = shift;
185    
186            my $time = shift || croak "need downtime timestamp to calculate uptime";
187    
188            # calculate offset -- that is number of seconds since midnight
189            my @lt = gmtime($time);
190    
191            # check if day falls into dayMask
192            return 0 if (! $self->_dayOk($lt[6]) );
193    
194            my $offset = $lt[2];    # hour
195            $offset *= 60;          # convert to minutes
196            $offset += $lt[1];      # minutes
197            $offset *= 60;          # convert to seconds
198            $offset += $lt[0];
199    
200            my $s=0;
201    
202            my $start = $self->{start};
203            my $end = $self->{end};
204    
205            print STDERR "start: $start end: $end time: $offset [$lt[2]:$lt[1]:$lt[0]]\n" if ($debug);
206    
207            if ( $end > $start ) {
208                    if ($offset > $start && $offset <= $end) {
209                            $s = $end - $offset;
210                    } elsif ($offset < $start) {
211                            $s = $end - $start;
212                    }
213            } elsif ( $start > $end ) {     # over midnight
214                    if ( $offset < $end ) {
215                            if ( $offset < $start) {
216                                    $s = $offset;
217                            } else {
218                                    $s = 0;
219                            }
220                    } else {
221                            if ( $offset < $start ) {
222                                    $s = SEC_PER_DAY - $end;
223                            } else {
224                                    $s = SEC_PER_DAY - $end + $start - $offset;
225                            }
226                    }
227            }
228                    
229            return $s;
230    }
231    
232    #
233    # this auxillary function will pretty-format interval in [days]d hh:mm:ss
234    #
235    
236    sub fmt_interval {
237            my $s = shift || 0;
238            my $out = "";
239    
240            my $d = int($s/(24*60*60));
241            $s = $s % (24*60*60);
242            my $h = int($s/(60*60));
243            $s = $s % (60*60);
244            my $m = int($s/60);
245            $s = $s % 60;
246            
247            $out .= $d."d " if ($d > 0);
248    
249            $out .= sprintf("%02d:%02d:%02d",$h,$m,$s);
250    
251            return $out;
252    }
253    
254    #
255    # this function will calculate uptime for some interval
256    #
257    
258    sub interval {
259            my $self = shift;
260            my $from = shift || croak "need start time for interval";
261            my $to = shift || croak "need end time for interval";
262    
263            print STDERR "from:\t$from\t",scalar gmtime($from),"\n" if ($debug);
264            print STDERR "to:\t$to\t",scalar gmtime($to),"\n" if ($debug);
265    
266            my $total = 0;
267    
268            # calc first day availability
269            print STDERR "t:\t$from\t",scalar gmtime($from),"\n" if ($debug);
270            $total += $self->uptime($from);
271    
272            print STDERR "total: $total (first)\n" if ($debug);
273    
274            # add all whole days
275    
276            my $sec_in_day = $self->sec_in_interval;
277            my $day = 86400;        # 24*60*60
278    
279            my $loop_start_time = int($from/$day)*$day + $day;
280            my $loop_end_time = int($to/$day)*$day - $day;
281    
282            print STDERR "loop (start - end): $loop_start_time - $loop_end_time\n" if ($debug);
283    
284            for (my $t = $loop_start_time; $t <= $loop_end_time; $t += $day) {
285                    print STDERR "t:\t$t\t",scalar gmtime($t),"\n" if ($debug);
286                    $total += $sec_in_day if ($self->day_in_interval($t));
287                    print STDERR "total: $total (loop)\n" if ($debug);
288            }
289    
290            # add rest of last day
291            print STDERR "t:\t$to\t",scalar gmtime($to),"\n" if ($debug);
292    
293            $total = abs($total - $self->downtime($to));
294            print STDERR "total: $total (final)\n" if ($debug);
295    
296            return $total;
297    }
298    
299    #
300    # this function will check if day falls into interval
301    #
302    
303    sub day_in_interval {
304            my $self = shift;
305    
306            my $time = shift || croak "need timestamp to check if day is in interval";
307    
308            my @lt = gmtime($time);
309            return $self->_dayOk($lt[6]);
310    }
311    
312    #
313    # return seconds in defined interval
314    #
315    
316    sub sec_in_interval {
317            my $self = shift;
318    
319            # over midnight?
320            if ($self->{start} > $self->{end}) {
321                    return(86400 - $self->{start} + $self->{end});
322            } else {
323                    return($self->{end} - $self->{start});
324            }
325    }
326    
327  1;  1;
328  __END__  __END__
# Line 191  Time::Available - Perl extension to calc Line 350  Time::Available - Perl extension to calc
350    # calculate availablity in seconds from interval of uptime    # calculate availablity in seconds from interval of uptime
351    print $interval->interval($utime1,$utime2);    print $interval->interval($utime1,$utime2);
352    
353      # pretty print interval data (this will produce output '1d 11:11:11')
354      use Time::Available qw(:fmt_interval);
355      print fmt_interval(126671);
356    
357  =head1 DESCRIPTION  =head1 DESCRIPTION
358    
359  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 370  the following dayMask constants:
370  =over 4  =over 4
371    
372  =item *  =item *
373  Time::Avail::DAY_MONDAY  Time::Available::DAY_MONDAY
374    
375  =item *  =item *
376  Time::Avail::DAY_TUESDAY  Time::Available::DAY_TUESDAY
377    
378  =item *  =item *
379  Time::Avail::DAY_WEDNESDAY  Time::Available::DAY_WEDNESDAY
380    
381  =item *  =item *
382  Time::Avail::DAY_THURSDAY  Time::Available::DAY_THURSDAY
383    
384  =item *  =item *
385  Time::Avail::DAY_FRIDAY  Time::Available::DAY_FRIDAY
386    
387  =item *  =item *
388  Time::Avail::DAY_SATURDAY  Time::Available::DAY_SATURDAY
389    
390  =item *  =item *
391  Time::Avail::DAY_SUNDAY  Time::Available::DAY_SUNDAY
392    
393  =item *  =item *
394  Time::Avail::DAY_WEEKDAY  Time::Available::DAY_WEEKDAY
395    
396  =item *  =item *
397  Time::Avail::DAY_WEEKEND  Time::Available::DAY_WEEKEND
398    
399  =item *  =item *
400  Time::Avail::DAY_EVERYDAY  Time::Available::DAY_EVERYDAY
401    
402  =back  =back
403    
# Line 242  FIXME Line 405  FIXME
405    
406  =head2 EXPORT  =head2 EXPORT
407    
408  None by default. If you specify B<:days>, Time::Available will export all  None by default.
409    
410    If you specify B<:days>, Time::Available will export all
411  DAY_* constraints to your enviroment (causing possible pollution of name  DAY_* constraints to your enviroment (causing possible pollution of name
412  space). You have been warned.  space). You have been warned.
413    
414    With B<:fmt_interval> it will include function B<fmt_interval> which will
415    pretty-format interval into [days]d hh:mm:ss.
416    
417    
418  =head1 HISTORY  =head1 HISTORY
419    
# Line 262  Original version; based somewhat on Time Line 430  Original version; based somewhat on Time
430  =over 8  =over 8
431    
432  =item *  =item *
 Use croak and not die in module for better error handling  
   
 =item *  
433  Allow arbitary (array?) of holidays to be included.  Allow arbitary (array?) of holidays to be included.
434    
435  =back  =back
# Line 276  calculating of availability of some inte Line 441  calculating of availability of some inte
441  this module was born.  this module was born.
442    
443  More information about this module might be found on  More information about this module might be found on
444  http://www.rot13.org/~dpavlin/perl.html#cpan  http://www.rot13.org/~dpavlin/projects.html#cpan
445    
446  =head1 AUTHOR  =head1 AUTHOR
447    

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.26