/[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.5 by dpavlin, Sun Oct 5 20:55:19 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    
# Line 8  require Exporter; Line 8  require Exporter;
8    
9  our @ISA = qw(Exporter);  our @ISA = qw(Exporter);
10    
 # 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.  
11  our %EXPORT_TAGS = (  our %EXPORT_TAGS = (
12          'days' => [ qw(          'days' => [ qw(
13                  DAY_MONDAY                  DAY_MONDAY
# Line 27  our %EXPORT_TAGS = ( Line 20  our %EXPORT_TAGS = (
20                  DAY_WEEKDAY                  DAY_WEEKDAY
21                  DAY_WEEKEND                  DAY_WEEKEND
22                  DAY_EVERYDAY                  DAY_EVERYDAY
23          ) ]          ) ],
24            'fmt_interval' => [ qw(fmt_interval) ]
25  );  );
26    
27  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'days'} } );  our @EXPORT_OK = (
28            @{ $EXPORT_TAGS{'days'} },
29            @{ $EXPORT_TAGS{'fmt_interval'} }
30            );
31    
32  our @EXPORT = qw(  our @EXPORT;    # don't export anything by default!
           
 );  
33    
34  our $VERSION = '0.01';  our $VERSION = '0.01';
35    
# Line 68  sub new { Line 63  sub new {
63    
64          # calc start and stop seconds          # calc start and stop seconds
65          my ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{start},3);          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");          my $s = $hh * 3600 || die("need at least hour specified for start time");
68          $s += $mm * 60 if ($mm);          $s += $mm * 60 if ($mm);
69          $s += $ss if ($ss);          $s += $ss if ($ss);
# Line 76  sub new { Line 72  sub new {
72          die("need end time") if (! $self->{ARGS}->{end});          die("need end time") if (! $self->{ARGS}->{end});
73    
74          ($hh,$mm,$ss) = split(/:/,$self->{ARGS}->{end},3);          ($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");          $s = $hh * 3600 || die("need at least hour specified for end time");
77          $s += $mm * 60 if ($mm);          $s += $mm * 60 if ($mm);
78          $self->{end} = $s;          $self->{end} = $s;
# Line 93  sub new { Line 90  sub new {
90  # this sub (originally from Time::Avail) will return if day is applicable  # this sub (originally from Time::Avail) will return if day is applicable
91  #  #
92    
93  sub _dayOk($$) {  sub _dayOk($) {
94            my $self = shift;
95            my $day = shift || return;
96    
97          my( $dayMask, $day ) = @_;      # get parameters          my $dayMask = $self->{dayMask};
98    
99          my $dayOk = 0;          my $dayOk = 0;
100    
# Line 129  sub _dayOk($$) { Line 128  sub _dayOk($$) {
128  sub uptime {  sub uptime {
129          my $self = shift;          my $self = shift;
130    
131          my $time = shift || die "need uptime timestamp to calcualte uptime";          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;          my $s=0;
145    
146          my $start = $self->{start};          my $start = $self->{start};
147          my $end = $self->{end};          my $end = $self->{end};
148    
149          print STDERR "start: $start end: $end time: $time\n" if ($debug);          print STDERR "start: $start end: $end time: $offset\n" if ($debug);
150    
151          if( ( $end > $start ) && ( $time < $end ) ) {          if ( $end > $start ) {
152                  if ($time < $start) {                  if ($offset < $start) {
153                          $s = $end - $start;                          $s = $end - $start;
154                  } else {                  } elsif ($offset < $end) {
155                          $s = $end - $time;                          $s = $end - $offset;
156                  }                  }
157          } elsif( $start > $end ) {      # over midnight          } elsif ( $start > $end ) {     # over midnight
158                  if ( $time < $end ) {                  if ( $offset < $end ) {
159                          if ( $time < $start) {                          if ( $offset < $start) {
160                                  $s = SEC_PER_DAY - $start + $end - $time;                                  $s = SEC_PER_DAY - $start + $end - $offset;
161                          } else {                          } else {
162                                  $s = SEC_PER_DAY - $start + $end;                                  $s = SEC_PER_DAY - $start + $end;
163                          }                          }
164                  } else {                  } else {
165                          if ( $time < $start ) {                          if ( $offset < $start ) {
166                                  $s = SEC_PER_DAY - $start;                                  $s = SEC_PER_DAY - $start;
167                          } else {                          } else {
168                                  $s = SEC_PER_DAY - $time;                                  $s = SEC_PER_DAY - $offset;
169                          }                          }
170                  }                  }
171          }          }
# Line 163  sub uptime { Line 173  sub uptime {
173          return $s;          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;  1;
269  __END__  __END__
# Line 191  Time::Available - Perl extension to calc Line 291  Time::Available - Perl extension to calc
291    # calculate availablity in seconds from interval of uptime    # calculate availablity in seconds from interval of uptime
292    print $interval->interval($utime1,$utime2);    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  =head1 DESCRIPTION
299    
300  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 311  the following dayMask constants:
311  =over 4  =over 4
312    
313  =item *  =item *
314  Time::Avail::DAY_MONDAY  Time::Available::DAY_MONDAY
315    
316  =item *  =item *
317  Time::Avail::DAY_TUESDAY  Time::Available::DAY_TUESDAY
318    
319  =item *  =item *
320  Time::Avail::DAY_WEDNESDAY  Time::Available::DAY_WEDNESDAY
321    
322  =item *  =item *
323  Time::Avail::DAY_THURSDAY  Time::Available::DAY_THURSDAY
324    
325  =item *  =item *
326  Time::Avail::DAY_FRIDAY  Time::Available::DAY_FRIDAY
327    
328  =item *  =item *
329  Time::Avail::DAY_SATURDAY  Time::Available::DAY_SATURDAY
330    
331  =item *  =item *
332  Time::Avail::DAY_SUNDAY  Time::Available::DAY_SUNDAY
333    
334  =item *  =item *
335  Time::Avail::DAY_WEEKDAY  Time::Available::DAY_WEEKDAY
336    
337  =item *  =item *
338  Time::Avail::DAY_WEEKEND  Time::Available::DAY_WEEKEND
339    
340  =item *  =item *
341  Time::Avail::DAY_EVERYDAY  Time::Available::DAY_EVERYDAY
342    
343  =back  =back
344    
# Line 242  FIXME Line 346  FIXME
346    
347  =head2 EXPORT  =head2 EXPORT
348    
349  None by default. If you specify B<:days>, Time::Available will export all  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  DAY_* constraints to your enviroment (causing possible pollution of name
353  space). You have been warned.  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  =head1 HISTORY
360    
# Line 276  calculating of availability of some inte Line 385  calculating of availability of some inte
385  this module was born.  this module was born.
386    
387  More information about this module might be found on  More information about this module might be found on
388  http://www.rot13.org/~dpavlin/perl.html#cpan  http://www.rot13.org/~dpavlin/projects.html#cpan
389    
390  =head1 AUTHOR  =head1 AUTHOR
391    

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

  ViewVC Help
Powered by ViewVC 1.1.26