File Coverage

blib/lib/X10/Event.pm
Criterion Covered Total %
statement 9 51 17.6
branch 0 26 0.0
condition 0 36 0.0
subroutine 3 10 30.0
pod 0 7 0.0
total 12 130 9.2


line stmt bran cond sub pod time code
1             package X10::Event;
2              
3 1     1   4 use vars qw(@ISA);
  1         1  
  1         41  
4              
5 1     1   3014 use Storable;
  1         3738  
  1         71  
6              
7             @ISA = qw(Storable);
8              
9 1     1   8 use strict;
  1         3  
  1         749  
10              
11             sub new
12             {
13 0     0 0   my $type = shift;
14              
15 0           my $self;
16              
17 0 0         if (@_ == 1)
18             {
19 0           my ($hc, $uc, $func) = &parse_string(shift);
20              
21 0 0 0       return undef unless ($hc && $uc && $func);
      0        
22              
23 0           $self = {
24             house_code => $hc,
25             unit_code => $uc,
26             func => $func,
27             }
28             }
29              
30 0           bless $self, $type;
31              
32 0           return $self;
33             }
34              
35             sub house_code
36             {
37 0     0 0   my $self = shift;
38 0           return $self->{house_code};
39             }
40              
41             sub unit_code
42             {
43 0     0 0   my $self = shift;
44 0           return $self->{unit_code};
45             }
46              
47             sub func
48             {
49 0     0 0   my $self = shift;
50 0           return $self->{func};
51             }
52              
53             sub as_string
54             {
55 0     0 0   my $self = shift;
56              
57 0 0 0       if ($self->unit_code eq 'ALL' || $self->unit_code eq 'LIGHTS')
58             {
59 0           return join(' ', $self->house_code, $self->unit_code, $self->func);
60             }
61             else
62             {
63 0           return sprintf("%s%02s %s", $self->house_code, $self->unit_code, $self->func);
64             }
65             }
66              
67             ###
68              
69             # build a string of words that implement this event
70             sub compile
71             {
72 0     0 0   my $self = shift;
73              
74 0           my @words = ();
75              
76 0 0 0       if ($self->func eq 'ON' || $self->func eq 'OFF')
    0 0        
77             {
78 0 0 0       if ($self->unit_code eq 'LIGHTS' && $self->func eq 'ON')
    0 0        
    0 0        
79             {
80 0           push @words, sprintf("%sL1", $self->house_code);
81             }
82             elsif ($self->unit_code eq 'ALL' && $self->func eq 'OFF')
83             {
84 0           push @words, sprintf("%sA0", $self->house_code);
85             }
86             elsif ($self->unit_code > 0 && $self->unit_code <= 16)
87             {
88 0           push @words,
89             sprintf("%s%02s", $self->house_code, $self->unit_code),
90             sprintf("%s%2s", $self->house_code, substr($self->func, 0, 2));
91             }
92             else
93             {
94 0           warn sprintf "Unknown command: %s %s %s (%s)",
95             $self->house_code, $self->unit_code, $self->func, $_;
96             }
97             }
98             elsif ($self->func eq 'DIM' || $self->func eq 'BRIGHT')
99             {
100 0 0 0       if ($self->unit_code > 0 && $self->unit_code <= 16)
101             {
102 0           push @words,
103             sprintf("%s%02s", $self->house_code, $self->unit_code),
104             sprintf("%s%2s", $self->house_code, substr($self->func, 0, 2));
105             }
106             else
107             {
108 0           warn sprintf "Unknown command: %s %s %s (%s)",
109             $self->house_code, $self->unit_code, $self->func, $_;
110             }
111             }
112             else
113             {
114 0           warn sprintf "Unknown command: %s %s %s (%s)",
115             $self->house_code, $self->unit_code, $self->func, $_;
116             }
117              
118 0           return map {uc} @words;
  0            
119             }
120              
121              
122             ###
123              
124             sub parse_string
125             {
126 0     0 0   my $string = uc(shift);
127              
128 0 0         if ( $string =~ /^\s*([a-p])\s*(\d+|all|lights)\s*(on|off|dim|bright)\s*$/i )
129             {
130 0 0 0       if ( lc($2) eq 'all' && lc($3) eq 'off' )
    0 0        
    0 0        
131             {
132 0           return map {uc} ($1, $2, $3);
  0            
133             }
134             elsif ( lc($2) eq 'lights' && lc($3) eq 'on' )
135             {
136 0           return map {uc} ($1, $2, $3);
  0            
137             }
138             elsif ( $2 > 0 && $2 <= 16 )
139             {
140 0           return (uc($1), $2 * 1, uc($3));
141             }
142             else
143             {
144 0           return ();
145             }
146             }
147             else
148             {
149 0           return ();
150             }
151             }
152              
153              
154             1;
155