File Coverage

blib/lib/X10/SchedEvent.pm
Criterion Covered Total %
statement 12 83 14.4
branch 0 32 0.0
condition 0 23 0.0
subroutine 4 11 36.3
pod 0 7 0.0
total 16 156 10.2


line stmt bran cond sub pod time code
1              
2             # Copyright (c) 1999-2017 Rob Fugina
3             # Distributed under the terms of the GNU Public License, Version 3.0
4              
5             package X10::SchedEvent;
6              
7 1     1   494 use Time::ParseDate;
  1         9454  
  1         80  
8 1     1   9 use POSIX;
  1         2  
  1         8  
9              
10 1     1   1620 use strict;
  1         2  
  1         22  
11              
12 1     1   642 use Astro::SunTime;
  1         1863  
  1         759  
13              
14             sub new
15             {
16 0     0 0   my $type = shift;
17              
18 0           my $self = bless { @_ }, $type;
19              
20 0 0 0       unless ($self->{macro} && $self->{macro}->isa('X10::Macro'))
21             {
22 0           warn "No macro sent to create SchedEvent";
23 0           return undef;
24             }
25              
26 0 0         $self->{verbose} = 1 if $self->{debug};
27              
28 0           $self->{next_time} = int(time);
29 0           $self->reschedule;
30 0           $self->{last_time} = 0;
31              
32 0           return $self;
33             }
34              
35              
36              
37             sub run
38             {
39 0     0 0   my $self = shift;
40              
41             $self->{logger}->('info', "Running %s",
42             $self->{description} || 'unnamed event',
43 0 0 0       ) if $self->{verbose};
44              
45 0           $self->{macro}->run;
46             }
47              
48             sub reschedule
49             {
50 0     0 0   my $self = shift;
51              
52 0   0       $self->{last_time} = $self->{next_time} || 0;
53              
54 0   0       my $current = $self->{last_time} || time;
55 0           my $next;
56              
57 0 0 0       if (!exists $self->{repeat_type} || $self->{repeat_type} eq 'none')
    0          
58             {
59 0           return 0;
60             }
61             elsif ($self->{repeat_type} eq 'day')
62             {
63 0           my $new = parsedate(sprintf("today %s", $self->time('today')));
64              
65 0 0 0       if ($new <= time || $new <= $current)
66             {
67 0           $new = parsedate(sprintf("tomorrow %s", $self->time('tomorrow')));
68             }
69              
70             # check DOW loop here...
71 0 0 0       if (exists $self->{dowmask} && $self->{dowmask} > 0)
72             {
73 0           my @newarray = localtime($new);
74              
75 0           while ( ! ( (1 << $newarray[6]) & $self->{dowmask} ) )
76             {
77             $self->{logger}->('info', "Skipping %s...", strftime("%a %b %e %Y", @newarray))
78 0 0         if $self->{debug};
79 0           $newarray[3] += 1; # add one day
80              
81 0           @newarray = localtime(mktime(@newarray)); # normalize
82              
83             # find new time on that day...
84              
85 0           my $datestr = strftime("%a %b %e %Y", @newarray);
86              
87 0           my $time = $self->time($datestr);
88              
89 0           $new = parsedate(sprintf("%s %s", $time, $datestr), WHOLE => 1);
90 0           @newarray = localtime($new);
91             }
92              
93             }
94              
95 0           $next = $new;
96             }
97             else
98             {
99 0           $self->{logger}->('info', "Unsupported repeat type: %s", $self->{repeat_type});
100             }
101              
102              
103 0           $self->{next_time} = $next;
104              
105 0           return 1;
106             }
107              
108             sub next_time
109             {
110 0     0 0   my $self = shift;
111              
112 0           return $self->{next_time};
113             }
114              
115             sub controller
116             {
117 0     0 0   my $self = shift;
118              
119 0 0         if (@_)
120             {
121 0           $self->{macro}->controller(shift);
122             }
123              
124 0           return $self->{macro}->controller;
125             }
126              
127             sub description
128             {
129 0     0 0   my $self = shift;
130              
131 0 0         if (@_)
132             {
133 0           $self->{description} = shift;
134             }
135              
136 0           return $self->{description};
137             }
138              
139             sub time
140             {
141 0     0 0   my $self = shift;
142 0           my $date = shift;
143              
144             # offsets assumed not to force time across day boundaries...
145              
146 0           my $time;
147             my $sign;
148 0           my $offset;
149              
150 0 0         if ($self->{time} =~ /^\d?\d:\d\d$/)
    0          
    0          
151             {
152 0           $time = $self->{time};
153 0           $offset = 0;
154             }
155             elsif ($self->{time} =~ /^sunrise(\s*([+-])\s*(\d+))?$/)
156             {
157 0 0         $sign = ($2 eq '-') ? -1 : 1;
158 0   0       $offset = $3 || 0;
159             $time = sun_time(type => 'rise', date => $date,
160             latitude => $self->{latitude},
161             longitude => $self->{longitude},
162 0           );
163             }
164             elsif ($self->{time} =~ /^sunset(\s*([+-])\s*(\d+))?$/)
165             {
166 0 0         $sign = ($2 eq '-') ? -1 : 1;
167 0   0       $offset = $3 || 0;
168             $time = sun_time(type => 'set', date => $date,
169             latitude => $self->{latitude},
170             longitude => $self->{longitude},
171 0           );
172             }
173             else
174             {
175 0           $self->{logger}->('info', "Unknown time string: %s", $self->{time});
176 0           return undef;
177             }
178              
179 0 0         return $time unless $offset;
180              
181 0           my ($hour, $minute) = $time =~ /^(\d?\d):(\d\d)$/;
182              
183 0           $minute += $sign * $offset;
184              
185 0           while ($minute >= 60)
186             {
187 0           $minute -= 60;
188 0           $hour++;
189             }
190              
191 0           while ($minute < 0)
192             {
193 0           $minute += 60;
194 0           $hour--;
195             }
196              
197 0           return sprintf("%s:%02s", $hour, $minute);
198             }
199              
200              
201             1;
202