package X10::Controller; use X10::Device; use X10::Event; sub unique (&@); sub new { my $type = shift; my $self = bless { @_ }; bless $self, $type; $self->{logger} ||= sub { shift; printf(@_); print "\n"; }; $self->{verbose} = 1 if $self->{debug}; $self->{house_code} ||= 'A'; $self->{house_code} = uc($self->{house_code}); $self->{listeners} = []; $self->{output_word_queue} = []; $self->{states} = {}; $self->{working} = 0; return $self; } ### creating controlled devices... sub Appliance { my $self = shift; return new X10::Device( controller => $self, @_, ); } sub Lamp { my $self = shift; return new X10::Device( controller => $self, @_, ); } ### directing input/output sub register_listener { my $self = shift; my $coderef = shift; push @{$self->{listeners}}, $coderef; } # this is what the main program will use to find what to select() on sub select_fds { my $self = shift; # nothing, in this abstract class return (); } # this is what the main program will call when my FD is readable sub handle_input { my $self = shift; # there will be no input in this abstract class... } ### manipulating controlled devices sub on { my $self = shift; $self->send( map { new X10::Event(sprintf("%s ON", $_->address)) } @_ ); } sub off { my $self = shift; $self->send( map { new X10::Event(sprintf("%s OFF", $_->address)) } @_ ); } sub dim { my $self = shift; $self->send( map { new X10::Event(sprintf("%s DIM", $_->address)) } @_ ); } sub bright { my $self = shift; $self->send( map { new X10::Event(sprintf("%s BRIGHT", $_->address)) } @_ ); } sub lights_on { my $self = shift; my %params = @_; $self->send( new X10::Event( sprintf("%s LIGHTS ON", $params{house_code} || $self->{house_code} ) )); } sub all_off { my $self = shift; my %params = @_; $self->send( new X10::Event( sprintf("%s ALL OFF", $params{house_code} || $self->{house_code} ) )); } ### semi-private methods sub send { my $self = shift; $self->queue_words(map {$_->compile} @_); } sub send_one { my $self = shift; my $event = shift; # this sub ONLY SENDS ONE $self->queue_words($event->compile); } ### private stuff -- only to be called from me & derived modules sub got_events { my $self = shift; foreach (@_) { $self->got_event($_); } } sub got_event { my $self = shift; my $event = shift; foreach (@{$self->{listeners}}) { $_->($event); } } sub optimize_wordlist { my $self = shift; my @words; OPTPASS: while (@_) { if (scalar @_ >= 4) { my ($hc0, $cm0) = $_[0] =~ /^(.)(..)$/; my ($hc1, $cm1) = $_[1] =~ /^(.)(..)$/; my ($hc2, $cm2) = $_[2] =~ /^(.)(..)$/; my ($hc3, $cm3) = $_[3] =~ /^(.)(..)$/; if ( $_[1] eq $_[3] && ( $cm1 eq 'OF' || $cm1 eq 'ON' ) && $hc0 eq $hc1 && $hc0 eq $hc2 && $cm0 =~ /^\d\d$/ && $cm2 =~ /^\d\d$/ ) { $self->{logger}->('info', "Opt 1: %s\n", join(" ", @_[0..3])) if $self->{debug}; @_[0,1] = @_[1,0]; shift; next OPTPASS; } elsif ( $_[0] eq $_[2] && $cm0 =~ /^\d\d$/ && $cm2 =~ /^\d\d$/ # 0 & 2 are identical addresses && ( $cm1 eq 'OF' || $cm1 eq 'ON' || $cm1 eq 'BR' || $cm1 eq 'DI' ) ) { $self->{logger}->('info', "Opt 2: %s\n", join(" ", @_[0..3])) if $self->{debug}; shift; @_[0,1] = @_[1,0]; next OPTPASS; } } if (scalar @_ >= 3) { } if (scalar @_ >= 2) { if ($_[0] eq $_[1]) { $self->{logger}->('info', "Opt 3: %s\n", join(" ", @_[0..1])) if $self->{debug}; shift; next OPTPASS; } } push @words, shift; } return @words; } sub queue_words { my $self = shift; push @{$self->{output_word_queue}}, @_; @{$self->{output_word_queue}} = $self->optimize_wordlist(@{$self->{output_word_queue}}); $self->work; } sub work { my $self = shift; return if $self->{working}; $self->{working} = 1; while (my $word = shift @{$self->{output_word_queue}}) { $self->send_word($word); } $self->{working} = 0; } sub send_word { my $self = shift; my $word = shift; $self->{logger}->('info', "Sending word: %s", $word) if $self->{verbose}; $self->got_words($word); # here's the fake-out since we're abstract } # this does all the state-machine stuff to keep track of what's going on... # does NOT keep track of what devices are on/off sub got_words { my $self = shift; while ( my $word = shift ) { if ($word =~ /^([a-p])(\d\d)$/i) # got an address { my $hc = uc($1); my $uc = $2 * 1; unless (exists $self->{states}->{$hc}) { $self->{states}->{$hc}->{mode} = 'addr'; $self->{states}->{$hc}->{selected} = []; } if ($self->{states}->{$hc}->{mode} eq 'addr') { push @{$self->{states}->{$hc}->{selected}}, $uc; } elsif ($self->{states}->{$hc}->{mode} eq 'cmd') { $self->{states}->{$hc}->{mode} = 'addr'; $self->{states}->{$hc}->{selected} = [ $uc ]; } else { warn "Bleah: ", Dumper($self->{states}); } } elsif ($word =~ /^([a-p])(on|of|di|br)$/i) # got a cmd { my $hc = uc($1); my $cmd = uc($2); unless (exists $self->{states}->{$hc}) { $self->{states}->{$hc}->{mode} = 'addr'; $self->{states}->{$hc}->{selected} = []; } # use long versions $cmd = 'off' if $cmd eq 'OF'; $cmd = 'dim' if $cmd eq 'DI'; $cmd = 'bright' if $cmd eq 'BR'; $self->{states}->{$hc}->{mode} = 'cmd'; $self->got_events( map { new X10::Event(sprintf("%s%02s %s", $hc, $_, $cmd)) } unique { $_ } @{$self->{states}->{$hc}->{selected}} ); } elsif ($word =~ /^([a-p])(a0|l1)$/i) # got an 'all' cmd { my $hc = uc($1); my $cmd = uc($2); unless (exists $self->{states}->{$hc}) { $self->{states}->{$hc}->{mode} = 'addr'; $self->{states}->{$hc}->{selected} = []; } # use long versions $cmd = 'all off' if $cmd eq 'A0'; $cmd = 'lights on' if $cmd eq 'L1'; $self->{states}->{$hc}->{mode} = 'cmd'; $self->{states}->{$hc}->{selected} = []; $self->got_events( new X10::Event(sprintf("%s %s", $hc, $cmd)) ); } else { warn "Unknown word: ", $word; } } } ### sub unique (&@) { my($c,%hash) = shift; grep { not $hash{&$c}++ } @_; } 1;