File Coverage

blib/lib/X10.pm
Criterion Covered Total %
statement 33 121 27.2
branch 0 46 0.0
condition 0 6 0.0
subroutine 11 22 50.0
pod 0 3 0.0
total 44 198 22.2


line stmt bran cond sub pod time code
1             package X10;
2              
3 1     1   3317 use Data::Dumper;
  1         10197  
  1         74  
4 1     1   9 use File::Basename;
  1         3  
  1         106  
5 1     1   837 use FileHandle;
  1         13397  
  1         6  
6 1     1   1173 use POSIX;
  1         6173  
  1         6  
7              
8 1     1   2621 use strict;
  1         2  
  1         27  
9              
10 1     1   496 use X10::Macro;
  1         4  
  1         25  
11 1     1   622 use X10::MacroProc;
  1         3  
  1         29  
12 1     1   570 use X10::SchedEvent;
  1         3  
  1         32  
13 1     1   486 use X10::Scheduler;
  1         3  
  1         25  
14 1     1   407 use X10::Server;
  1         2  
  1         30  
15              
16 1     1   5 use vars qw($VERSION);
  1         1  
  1         1041  
17              
18             $VERSION = 0.03;
19              
20             sub new
21             {
22 0     0 0   my $type = shift;
23              
24 0           my $self = bless { @_ }, $type;
25              
26 0 0         $self->{verbose} = 1 if $self->{debug};
27 0     0     $self->{logger} = sub { $self->syslog(@_) };
  0            
28              
29 0 0         unless ($self->{controller_type})
30             {
31 0           warn "Interface type must be specified\n";
32 0           return undef;
33             }
34              
35 0           my $controller = $self->{controller_type};
36              
37 0 0         if (eval "require $controller")
38             {
39 0           $controller->import; # just in case
40             }
41             else
42             {
43 0           die "Can't load module for $controller: ", $@;
44             }
45              
46             $self->{controller} = $controller->new(
47             port => $self->{controller_port},
48             debug => $self->{debug},
49             verbose => $self->{verbose},
50 0     0     logger => sub { $self->syslog(@_) },
51 0           );
52              
53             $self->{controller}->register_listener(
54 0     0     sub { $self->syslog('info', "Event: %s", $_[0]->as_string) }
55 0           );
56              
57 0 0         if (exists $self->{devices})
58             {
59             # load device config
60             }
61              
62 0 0         if (exists $self->{schedulerconfig})
63             {
64             $self->{scheduler} = new X10::Scheduler(
65             configfile => $self->{schedulerconfig},
66             controller => $self->{controller},
67             debug => $self->{debug},
68             verbose => $self->{verbose},
69 0     0     logger => sub { $self->syslog(@_) },
70 0           latitude => 38.74274,
71             longitude => -90.560143,
72             );
73              
74 0 0         unless ($self->{scheduler})
75             {
76 0           warn "Problem creating macro processor";
77 0           return undef;
78             }
79              
80             }
81              
82 0 0         if (exists $self->{macroconfig})
83             {
84             $self->{macrop} = new X10::MacroProc(
85             configfile => $self->{macroconfig},
86             controller => $self->{controller},
87             debug => $self->{debug},
88             verbose => $self->{verbose},
89 0     0     logger => sub { $self->syslog(@_) },
90 0           );
91              
92 0 0         unless ($self->{macrop})
93             {
94 0           warn "Problem creating macro processor";
95 0           return undef;
96             }
97              
98             }
99              
100 0 0         if (exists $self->{server_port})
101             {
102             $self->{server} = new X10::Server(
103             controller => $self->{controller},
104             debug => $self->{debug},
105             verbose => $self->{verbose},
106             server_port => $self->{server_port},
107 0     0     logger => sub { $self->syslog(@_) },
108 0           );
109              
110 0 0         unless ($self->{server})
111             {
112 0           warn "Problem creating network server";
113 0           return undef;
114             }
115             }
116              
117 0           return $self;
118             }
119              
120              
121             sub run
122             {
123 0     0 0   my $self = shift;
124              
125             # this method plans to never return...
126              
127 0           $self->{running} = 1;
128              
129 0     0     $SIG{'INT'} = sub { $self->{running} = 0; };
  0            
130 0     0     $SIG{'TERM'} = sub { $self->{running} = 0; };
  0            
131              
132 0           $self->syslog('info', "%s service starting", $self->{controller_type});
133              
134 0           my $next_wakeup = 0;
135              
136             X10RUNMAINLOOP:
137 0           while ($self->{running})
138             {
139 0 0         $self->{logger}->('info', "Entering mainloop") if $self->{debug};
140              
141 0           my %fdindex;
142 0           foreach my $module (
  0            
143             grep { exists $self->{$_} } qw(controller server macrop)
144             )
145             {
146 0           foreach my $fd ($self->{$module}->select_fds)
147             {
148 0           $fdindex{$fd} = $self->{$module};
149             }
150             }
151              
152 0 0         $self->syslog('info', "All FDs are %s\n", join(', ', keys %fdindex)) if $self->{debug};
153              
154 0           my $rfd = '';
155 0           foreach (keys %fdindex) { vec($rfd, $_, 1) = 1; }
  0            
156              
157             # done setting up FD array
158              
159             # figure out if we have to wake up at a certain time:
160              
161 0           my $timeout = undef;
162              
163 0 0         if ($self->{scheduler})
164             {
165 0           my $next_event_time = $self->{scheduler}->next_event_time;
166              
167 0 0         if ($next_event_time)
168             {
169 0           $timeout = $next_event_time - int(time);
170 0 0         $timeout = 0 if ($timeout < 0);
171             }
172              
173 0 0 0       if ( (defined $timeout) && $next_event_time != $next_wakeup)
174             {
175 0           $next_wakeup = $next_event_time;
176 0           $self->syslog('info', "Next Scheduled Event: %s (%s seconds away)",
177             strftime("%a %b %e %H:%M %Y", localtime($next_event_time)),
178             $timeout,
179             );
180             }
181              
182             }
183              
184             # done calculating wakeup time
185              
186 0           my $readers;
187 0           my $fdcount = select($readers=$rfd, undef, undef, $timeout);
188              
189 0 0 0       if ($fdcount > 0)
    0          
190             {
191 0 0         $self->{logger}->('info', "Got %s FDs to handle", $fdcount) if $self->{debug};
192              
193 0           foreach (keys %fdindex)
194             {
195 0 0         if (vec($readers, $_, 1))
196             {
197 0 0         $self->syslog('info', "Processing input on FD %s (%s)\n", $_, $fdindex{$_}) if $self->{debug};
198 0           $fdindex{$_}->handle_input;
199             }
200             }
201              
202             }
203             elsif ($fdcount < 0 && $! != 4) # ignore Interrupted System Call
204             {
205 0           $self->{logger}->('info', "Error %d in select(): %s", $!, $!);
206             }
207              
208 0 0         if ($self->{scheduler})
209             {
210 0           $self->{scheduler}->run;
211             }
212              
213             }
214              
215 0           $self->syslog('info', "%s service shutting down", $self->{controller_type});
216              
217             }
218              
219             sub syslog
220             {
221 0     0 0   my $self = shift;
222              
223 0           my $level = shift;
224 0           my $format = shift;
225 0           my $message = sprintf($format, @_);
226              
227 0           my $facility = "local5";
228 0           my $tag = sprintf "%s[%s]",
229             basename($0, ".pl"),
230             $$,
231             ;
232              
233 0 0         if ($self->{debug})
234             {
235 0           printf "syslog message: %s\n", $message;
236             }
237             else
238             {
239 0           my $fh = new FileHandle;
240 0           $fh->open("|/usr/bin/logger -p $facility.$level -t $tag");
241 0           $fh->print($message);
242 0           $fh->close;
243             }
244             }
245              
246              
247              
248             1;
249