File Coverage

blib/lib/X10/MacroProc.pm
Criterion Covered Total %
statement 9 50 18.0
branch 0 18 0.0
condition 0 10 0.0
subroutine 3 11 27.2
pod 0 6 0.0
total 12 95 12.6


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::MacroProc;
6              
7             # this package implements a macro processor using an event callback mechanism
8              
9 1     1   4 use Data::Dumper;
  1         1  
  1         55  
10              
11 1     1   9 use strict;
  1         1  
  1         46  
12              
13 1     1   4 use X10::Event;
  1         1  
  1         615  
14              
15             sub new
16             {
17 0     0 0   my $type = shift;
18              
19 0           my $self = bless { @_ }, $type;
20              
21 0 0         return undef unless $self->{controller};
22              
23             $self->{logger} ||= sub {
24 0     0     shift;
25 0           printf(@_);
26 0           print "\n";
27 0   0       };
28              
29 0 0         $self->{verbose} = 1 if $self->{debug};
30              
31 0           $self->{controller}->register_listener($self->event_callback);
32 0           $self->{macros} = {};
33              
34 0 0         if ($self->{configfile})
35             {
36 0   0       my $config = eval { require $self->{configfile} } || die $@;
37              
38 0           foreach (keys %$config)
39             {
40 0           $self->add( $_ => $config->{$_} );
41             }
42             }
43              
44 0           return $self;
45             }
46              
47             ###
48              
49             sub add
50             {
51 0     0 0   my $self = shift;
52 0           my ($key, $macro) = @_;
53              
54 0           my $nkey = X10::Event->new($key)->as_string;
55              
56             $self->{logger}->('info', "Replacing old macro for %s", $nkey)
57 0 0         if exists $self->{macros}->{$nkey};
58              
59 0           $self->{macros}->{$nkey} = $macro;
60 0           $self->{macros}->{$nkey}->controller($self->{controller});
61             }
62              
63             sub setup
64             {
65 0     0 0   my $self = shift;
66              
67 0 0         if (@_)
68             {
69 0           while (my $key = shift)
70             {
71 0           my $nkey = X10::Event->new($key)->as_string;
72              
73 0 0         if ($nkey)
74             {
75 0           $self->{macros}->{$nkey} = shift;
76 0           $self->{macros}->{$nkey}->controller($self->{controller});
77             }
78             else
79             {
80 0           $self->{logger}->('info', "Throwing away macro for ", $key);
81 0           shift;
82             }
83             }
84              
85             }
86              
87 0           return $self->{macros};
88             }
89              
90             sub event_callback
91             {
92 0     0 0   my $self = shift;
93 0     0     return sub { $self->handle_event(shift) };
  0            
94             }
95              
96             sub handle_event
97             {
98 0     0 0   my $self = shift;
99 0           my $event = shift;
100              
101 0 0         if (exists $self->{macros}->{$event->as_string})
    0          
102             {
103             $self->{logger}->('info', "Macro: %s",
104 0   0       $self->{macros}->{$event->as_string}->description || $event->as_string
105             );
106              
107             $self->{macros}->{$event->as_string}->run
108             || $self->{logger}->('info', "Problem running macro: %s",
109 0 0 0       $self->{macros}->{$event->as_string}->description
110             || $event->as_string);
111             }
112             elsif ($self->{debug})
113             {
114 0           $self->{logger}->('info', "No macro for %s", $event->as_string);
115             }
116              
117             }
118              
119             sub select_fds
120             {
121 0     0 0   return ();
122             }
123              
124              
125             1;
126