--- a/lib/Quancom/Test/Server.pm	Mon Jan 05 21:44:56 2009 +0100
+++ b/lib/Quancom/Test/Server.pm	Tue Jan 06 02:01:26 2009 +0100
@@ -28,7 +28,13 @@
 use IO::Socket;
 use IO::Select;
 
-my $STX = "\x02";
+my $STX   = "\x02";
+my %ERROR = (
+    checksum  => pack("ac", "E", 0),
+    character => pack("ac", "E", 1),
+    command   => pack("ac", "E", 2),
+    width     => pack("ac", "E", 3),
+);
 
 sub new {
     my $class = ref $_ ? ref shift : shift;
@@ -75,7 +81,7 @@
 
 sub show {
     my $self = shift;
-    printf STDERR "%0v8b\n", join "", @{ $self->{outputs} };
+    printf STDERR "%0v8b\n", join "", reverse @{ $self->{outputs} };
 }
 
 sub DESTROY {
@@ -117,6 +123,7 @@
                 chomp $l;
                 $l = $self->_process($l);
                 $c->print($l . "\r");
+		$self->show;
             }
         }
         return;
@@ -126,6 +133,7 @@
     while (<>) {
         chomp;
         print $self->_process($_), "\n";
+	$self->show;
     }
 }
 
@@ -140,7 +148,7 @@
 
     warn "got: <STX>$line($1)\n" if $self->{debug};
 
-    return pack("ac", "E", 1)    # checksum error
+    return $ERROR{checksum}
       if $1 ne ".." and hex($1) != unpack("%8C*", "$STX$line");
 
     my ($jid, $cmd, $width, $addr, $data) = (
@@ -155,32 +163,45 @@
 
     # some transformations for more easy use
     $addr = hex($addr);
-    $width =
-        $width eq "B" ? 1
-      : $width eq "W" ? 2
-      : $width eq "L" ? 3
-      : $width eq "X" ? 4
+    $width = $width eq "B"
+      ? 1    #  8 bit
+      : $width eq "W" ? 2    # 16 bit
+      : $width eq "L" ? 4    # 32 bit
+      : $width eq "X" ? 8    # 64 bit
       :                 0;
 
+    my @data = reverse ($data =~ /(..)/g); # msb
+    my $offset = $addr - 0x100;
+
     if ($cmd eq "W") {
-        my @data = $data =~ /(..)/g;
-        return pack("ac", "E", 3)    # width error
-          if @data != $width;
-
-        my $offset = $addr - 0x100;
+        return $ERROR{width} if @data != $width;
 
         @{ $self->{outputs} }[ $offset .. $offset + $width - 1 ] =
           map { pack "C", hex($_) } @data;
-        $self->show;
-
-        $retval = "O$jid";
-    }
-    else {
-        warn "command \"$cmd\" not supported\n";
-        $retval = pack("ac", "E", 2);
+        return _with_checksum("O$jid");
     }
 
-    return $retval . sprintf("%02x", unpack("%8C*", $retval));
+    if ($cmd =~ /^[SC]$/) {
+        # currently restricted to 4 byte (32bit)
+        return $ERROR{command} if $width != 4;
+        return $ERROR{width}   if @data != 4;
+        foreach (@{ $self->{outputs} }[ $offset .. $offset + $width - 1 ]) {
+            if ($cmd eq "S") {
+                $_ |= pack("C", hex(shift @data));
+            }
+	    else {
+		$_ &= ~pack("C", hex(shift @data));
+	    }
+        }
+        return _with_checksum("O$jid");
+    }
+
+    warn "command \"$cmd\" not supported\n";
+    return $ERROR{command};
+}
+
+sub _with_checksum {
+    $_[0] . sprintf("%02x", unpack("%8C*", $_[0]));
 }
 
 1;
@@ -215,3 +236,21 @@
 		    will be removed afterwards)
 
 =back
+
+=head1 BUGS
+
+Not all commands/registers are implemented. Currently the following
+operations are supported:
+
+=over
+
+=item B<W>
+
+Setting of outputs 0x100 .. 0x107
+
+=item B<S> and B<C>
+
+Bit-Set/Clear operations (works only on address 0x100 and 0x104) since
+it always expects 32 bit!
+
+=back