26 use warnings; |
26 use warnings; |
27 use Carp; |
27 use Carp; |
28 use IO::Socket; |
28 use IO::Socket; |
29 use IO::Select; |
29 use IO::Select; |
30 |
30 |
31 my $STX = "\x02"; |
31 my $STX = "\x02"; |
|
32 my %ERROR = ( |
|
33 checksum => pack("ac", "E", 0), |
|
34 character => pack("ac", "E", 1), |
|
35 command => pack("ac", "E", 2), |
|
36 width => pack("ac", "E", 3), |
|
37 ); |
32 |
38 |
33 sub new { |
39 sub new { |
34 my $class = ref $_ ? ref shift : shift; |
40 my $class = ref $_ ? ref shift : shift; |
35 |
41 |
36 my $self = bless {} => $class; |
42 my $self = bless {} => $class; |
115 my $l = <$c>; |
121 my $l = <$c>; |
116 $s->remove($c), next if not defined $l; |
122 $s->remove($c), next if not defined $l; |
117 chomp $l; |
123 chomp $l; |
118 $l = $self->_process($l); |
124 $l = $self->_process($l); |
119 $c->print($l . "\r"); |
125 $c->print($l . "\r"); |
|
126 $self->show; |
120 } |
127 } |
121 } |
128 } |
122 return; |
129 return; |
123 } |
130 } |
124 |
131 |
125 # STDIO communication |
132 # STDIO communication |
126 while (<>) { |
133 while (<>) { |
127 chomp; |
134 chomp; |
128 print $self->_process($_), "\n"; |
135 print $self->_process($_), "\n"; |
|
136 $self->show; |
129 } |
137 } |
130 } |
138 } |
131 |
139 |
132 sub _process { |
140 sub _process { |
133 my $self = shift; |
141 my $self = shift; |
138 $line =~ s/^$STX//; # cut STX, if any |
146 $line =~ s/^$STX//; # cut STX, if any |
139 $line =~ s/(..)$//; # cut checksum |
147 $line =~ s/(..)$//; # cut checksum |
140 |
148 |
141 warn "got: <STX>$line($1)\n" if $self->{debug}; |
149 warn "got: <STX>$line($1)\n" if $self->{debug}; |
142 |
150 |
143 return pack("ac", "E", 1) # checksum error |
151 return $ERROR{checksum} |
144 if $1 ne ".." and hex($1) != unpack("%8C*", "$STX$line"); |
152 if $1 ne ".." and hex($1) != unpack("%8C*", "$STX$line"); |
145 |
153 |
146 my ($jid, $cmd, $width, $addr, $data) = ( |
154 my ($jid, $cmd, $width, $addr, $data) = ( |
147 $line =~ / |
155 $line =~ / |
148 ([\da-f]{2}) # jid |
156 ([\da-f]{2}) # jid |
153 $/xi |
161 $/xi |
154 ); |
162 ); |
155 |
163 |
156 # some transformations for more easy use |
164 # some transformations for more easy use |
157 $addr = hex($addr); |
165 $addr = hex($addr); |
158 $width = |
166 $width = $width eq "B" |
159 $width eq "B" ? 1 |
167 ? 1 # 8 bit |
160 : $width eq "W" ? 2 |
168 : $width eq "W" ? 2 # 16 bit |
161 : $width eq "L" ? 3 |
169 : $width eq "L" ? 4 # 32 bit |
162 : $width eq "X" ? 4 |
170 : $width eq "X" ? 8 # 64 bit |
163 : 0; |
171 : 0; |
164 |
172 |
|
173 my @data = reverse ($data =~ /(..)/g); # msb |
|
174 my $offset = $addr - 0x100; |
|
175 |
165 if ($cmd eq "W") { |
176 if ($cmd eq "W") { |
166 my @data = $data =~ /(..)/g; |
177 return $ERROR{width} if @data != $width; |
167 return pack("ac", "E", 3) # width error |
|
168 if @data != $width; |
|
169 |
|
170 my $offset = $addr - 0x100; |
|
171 |
178 |
172 @{ $self->{outputs} }[ $offset .. $offset + $width - 1 ] = |
179 @{ $self->{outputs} }[ $offset .. $offset + $width - 1 ] = |
173 map { pack "C", hex($_) } @data; |
180 map { pack "C", hex($_) } @data; |
174 $self->show; |
181 return _with_checksum("O$jid"); |
175 |
182 } |
176 $retval = "O$jid"; |
183 |
177 } |
184 if ($cmd =~ /^[SC]$/) { |
178 else { |
185 # currently restricted to 4 byte (32bit) |
179 warn "command \"$cmd\" not supported\n"; |
186 return $ERROR{command} if $width != 4; |
180 $retval = pack("ac", "E", 2); |
187 return $ERROR{width} if @data != 4; |
181 } |
188 foreach (@{ $self->{outputs} }[ $offset .. $offset + $width - 1 ]) { |
182 |
189 if ($cmd eq "S") { |
183 return $retval . sprintf("%02x", unpack("%8C*", $retval)); |
190 $_ |= pack("C", hex(shift @data)); |
|
191 } |
|
192 else { |
|
193 $_ &= ~pack("C", hex(shift @data)); |
|
194 } |
|
195 } |
|
196 return _with_checksum("O$jid"); |
|
197 } |
|
198 |
|
199 warn "command \"$cmd\" not supported\n"; |
|
200 return $ERROR{command}; |
|
201 } |
|
202 |
|
203 sub _with_checksum { |
|
204 $_[0] . sprintf("%02x", unpack("%8C*", $_[0])); |
184 } |
205 } |
185 |
206 |
186 1; |
207 1; |
187 |
208 |
188 __END__ |
209 __END__ |
213 filename server creates and binds to the named socket |
234 filename server creates and binds to the named socket |
214 file (the file gets created by the server and |
235 file (the file gets created by the server and |
215 will be removed afterwards) |
236 will be removed afterwards) |
216 |
237 |
217 =back |
238 =back |
|
239 |
|
240 =head1 BUGS |
|
241 |
|
242 Not all commands/registers are implemented. Currently the following |
|
243 operations are supported: |
|
244 |
|
245 =over |
|
246 |
|
247 =item B<W> |
|
248 |
|
249 Setting of outputs 0x100 .. 0x107 |
|
250 |
|
251 =item B<S> and B<C> |
|
252 |
|
253 Bit-Set/Clear operations (works only on address 0x100 and 0x104) since |
|
254 it always expects 32 bit! |
|
255 |
|
256 =back |