# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1231235788 -3600
# Node ID ecc10b50b7a67cf3c6a1db82a344b9610da509e0
# Parent  246d80ec66536f79e788a062ffac07bbff48e886
Improved example. More simplified usage of example.

diff -r 246d80ec6653 -r ecc10b50b7a6 examples/client
--- a/examples/client	Tue Jan 06 09:31:17 2009 +0100
+++ b/examples/client	Tue Jan 06 10:56:28 2009 +0100
@@ -14,44 +14,36 @@
     my $r;
 
     # reset
-    $r = $q->cmd("SL000700000001"); 
-    print $r->ok ? $r->data : $r->error_message, "\n";
-
-    sleep 1;
-    $r = $q->cmd("WX0100FFFFFFFFFFFFFFFF");
-    print $r->ok ? $r->data : $r->error_message, "\n";
-
-    sleep 1;
-    # switch off all lights
-    $r = $q->cmd("WX01000000000000000000");
-    print $r->ok ? $r->data : $r->error_message, "\n";
-
-    sleep 1;
-    $r = $q->cmd("WB0100FF");
-    print $r->ok ? $r->data : $r->error_message, "\n";
-
-    sleep 1;
-    $r = $q->cmd("WB010001");	# 1 bit setzen
+    $r = $q->full_reset;
     print $r->ok ? $r->data : $r->error_message, "\n";
 
-    sleep 1;
-    $r = $q->cmd("WB010055");	# 0101|0101
-    print $r->ok ? $r->data : $r->error_message, "\n";
-
-    sleep 1;
-    $r = $q->cmd("WB0100AA");	# 1010|1010
-    print $r->ok ? $r->data : $r->error_message, "\n";
+    foreach (
+        qw(
+        WX.0100.FF.FF.FF.FF.FF.FF.FF.FF
+        WX.0100.00.00.00.00.00.00.00.00
+        WB.0100.FF
+        WB.0100.01
+        WB.0100.55
+        WB.0100.AA
+        WL.0100.00.55.00.55
+        SL.0100.00.55.00.55
+        CL.0100.00.55.00.55
+        )
+      )
+    {
+        $r = $q->cmd($_);
+        print "err: " . $r->error_message . "\n" if not $r->ok;
 
-    sleep 1;
-    $r = $q->cmd("WW0100AAAA");	# 1010|1010 1010|1010
-    print $r->ok ? $r->data : $r->error_message, "\n";
+	/.(.)\.(....)/;
+	$r = $q->cmd("R$1$2");
+	if ($r->ok) {
+	    print "got: " . $r->data . "\n";
+	} 
+	else {
+	    print "err: " . $r->error_message . "\n" if not $r->ok;
+	}
+	sleep 1;
+    }
 
-    sleep 1;
-    $r = $q->cmd("SL010000550055");	# + 1010|1010 0000|0000 0101|0101
-    print $r->ok ? $r->data : $r->error_message, "\n";
-
-    sleep 1;
-    $r = $q->cmd("CL010000000055");	# - 0101|0101
-    print $r->ok ? $r->data : $r->error_message, "\n";
 }
 
diff -r 246d80ec6653 -r ecc10b50b7a6 lib/Quancom.pm
--- a/lib/Quancom.pm	Tue Jan 06 09:31:17 2009 +0100
+++ b/lib/Quancom.pm	Tue Jan 06 10:56:28 2009 +0100
@@ -29,6 +29,7 @@
 our $VERSION = 0.1;
 
 my $DEFAULT_PORT = 1001;
+my $STX          = "\x02";
 
 sub new {
     my $class = ref $_[0] ? ref shift : shift;
@@ -64,11 +65,22 @@
     my $cmd  = shift;
 
     $self->_tx($cmd);
-    $self->_rx($cmd);
+    $self->_rx;
 
     return $self->{last_result};
 }
 
+sub reset {
+    my $self = shift;
+    $self->cmd("SL 0007 00.00.00.01");
+}
+
+sub full_reset {
+    my $self = shift;
+    $self->reset->ok or return $self->{last_result};
+    $self->cmd("WB 0007 00");
+}
+
 sub TIESCALAR {
     my $class = shift;
     my ($ip)  = @_;
@@ -90,22 +102,25 @@
     my $self = shift;
     my $cmd  = shift;
 
+    $cmd =~ s/[^A-Z\d]//g;
+
     $self->{job} = ++$self->{job} % 255;    # cap the job id on 255;
-    $cmd = "\x02" . sprintf("%02x", $self->{job}) . $cmd;   # add STX and job id
-    $cmd .= sprintf("%02x", unpack("%8C*", $cmd));          # add checksum
+    $cmd = $STX . sprintf("%02x", $self->{job}) . $cmd;    # add STX and job id
+    $cmd .= sprintf("%02x", unpack("%8C*", $cmd));         # add checksum
 
-    warn "sending $cmd\n";
+    $cmd =~ /^.(..)(......)(.*)(..)/;
+    warn "sending $1 $2 $3 ($4)\n";
     $self->{socket}->print($cmd . "\r");
 }
 
 sub _rx {
     my $self = shift;
 
-    local $/ = "\r";    # CR is the delimiter
+    local $/ = "\r";                                       # CR is the delimiter
 
     local $_ = $self->{socket}->getline;
-    $self->{last_result} = new Quancom::Result($_);
-
+    # chomp; warn "<<$_>>\n";
+    return $self->{last_result} = new Quancom::Result($_);
 }
 
 1;
@@ -147,6 +162,18 @@
 all bits on the first relais. Some other (untested) string for setting
 just the lowest bit on the first relais should be "WB010001".
 
+=item B<reset>( )
+
+This resets the device by setting the reset control flag.
+B<Note:> It doesn't reset timeouts etc. To reset these, use
+L<full_reset()>.
+
+=item B<full_reset>( )
+
+This clears the outputs AND resets timeouts by writing zero 
+to all control bits.
+
+
 =item B<last_result>( )
 
 This returns an object containing the last result.
diff -r 246d80ec6653 -r ecc10b50b7a6 lib/Quancom/Result.pm
--- a/lib/Quancom/Result.pm	Tue Jan 06 09:31:17 2009 +0100
+++ b/lib/Quancom/Result.pm	Tue Jan 06 10:56:28 2009 +0100
@@ -27,8 +27,7 @@
     $r =~ s/\s*$//;    # should match any \r or \n too
 
     # decode the status
-    if ((my $e) = $r =~ /^E(.)/) {
-	$self->{error_code} = unpack("C", $e);
+    if (($self->{error_code}) = $r =~ /^E(.)/) {
         $self->{ok} = 0;
     }
     elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) {
diff -r 246d80ec6653 -r ecc10b50b7a6 lib/Quancom/Test/Server.pm
--- a/lib/Quancom/Test/Server.pm	Tue Jan 06 09:31:17 2009 +0100
+++ b/lib/Quancom/Test/Server.pm	Tue Jan 06 10:56:28 2009 +0100
@@ -30,10 +30,10 @@
 
 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),
+    checksum  => "E0",
+    character => "E1",
+    command   => "E2",
+    width     => "E3",
 );
 
 sub new {