# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1231250823 -3600
# Node ID a6bc8818d069e8c96734143979ac4a3399737f3f
# Parent  ecc10b50b7a67cf3c6a1db82a344b9610da509e0
Bug. Timeout.

But the set_timeout() does not work as expected. Needs more
investigation. Or better documentation on Quancom pages.

diff -r ecc10b50b7a6 -r a6bc8818d069 doc/api.txt
--- a/doc/api.txt	Tue Jan 06 10:56:28 2009 +0100
+++ b/doc/api.txt	Tue Jan 06 15:07:03 2009 +0100
@@ -5,22 +5,20 @@
     
 * set/clear single outputs (set_bit?)
 
-    # $state:	"on", "off", 0, 1
     # $output:	0..63
+    # $state:	true / false (in the sense of perl)
 
-    set($state => $output, ...)
-    set($state => [$output, ...])
+    set($output => $state);
+    set(@outputs => $state);
 
     Examples
 
     # setting single outputs
-    set(on => 0, off => 1, on => 2, off => 3, ....., off => 7);
-    set(on => [0, 2], off => [1, 3 .. 7]);
 
-    # alternate form of the above 
-    set(1 => 0, 0 => 1, 1 => 2, 0 => 3, ...., 0 => 7);
-    set(1 => [0, 2], on => [1, 3 ... 7]);
-
+    set($output => 0);
+    set($output1, $output2 => 0);
+    set($output1, $output2 => 0);
+    set(1..30, 1);
 
     # explicitly switch on
     on(0, 2);
@@ -30,7 +28,7 @@
 * read a single output (get_bit?)
 
     $result = get($output);
-    @result = get($output, ...);
+    @result = get(@outputs);
 
     Examples
 
@@ -65,6 +63,7 @@
 
     $outputs[0] = 1;
     @outputs = (1, 0, 1, 0, 0, 0);
+    @outputs[1..30] = ....
 
     my $block0;
     tie $block => "Quancom" $ip_address, $block, $len;
diff -r ecc10b50b7a6 -r a6bc8818d069 examples/client
--- a/examples/client	Tue Jan 06 10:56:28 2009 +0100
+++ b/examples/client	Tue Jan 06 15:07:03 2009 +0100
@@ -14,8 +14,16 @@
     my $r;
 
     # reset
-    $r = $q->full_reset;
-    print $r->ok ? $r->data : $r->error_message, "\n";
+    $q->full_reset->ok or die $q->last_result->error_message;
+
+    # does not work
+    #$q->cmd("RB 0007")->ok or die $q->last_result->error_message;
+    #print "***: " . $q->last_result->data . "\n";
+    #$q->set_timeout(5)->ok    or die $q->last_result->error_message;
+    #$q->cmd("WB 0100 FF")->ok or die $q->last_result->error_message;
+    #$q->cmd("RB 0007")->ok    or die $q->last_result->error_message;
+    #print "***: " . $q->last_result->data . "\n";
+    #exit;
 
     foreach (
         qw(
@@ -28,21 +36,22 @@
         WL.0100.00.55.00.55
         SL.0100.00.55.00.55
         CL.0100.00.55.00.55
+        WX.0100.FF.FF.FF.FF.FF.FF.FF.FF
         )
       )
     {
         $r = $q->cmd($_);
         print "err: " . $r->error_message . "\n" if not $r->ok;
 
-	/.(.)\.(....)/;
-	$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;
+        /.(.)\.(....)/;
+        $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;
     }
 
 }
diff -r ecc10b50b7a6 -r a6bc8818d069 lib/Quancom.pm
--- a/lib/Quancom.pm	Tue Jan 06 10:56:28 2009 +0100
+++ b/lib/Quancom.pm	Tue Jan 06 15:07:03 2009 +0100
@@ -81,6 +81,21 @@
     $self->cmd("WB 0007 00");
 }
 
+sub set_timeout {
+    my $self = shift;
+    my $to = shift;
+
+    # timeout 3 (2.8s)
+    # [__--.-___]
+    #     1 1	    0x18
+    #   1           0x58
+    $to = sprintf "%02x", ($to << 3 | 0x42);
+    $self->cmd("SL 0007 00.00.00.$to");
+}
+
+sub clear_timeout {
+}
+
 sub TIESCALAR {
     my $class = shift;
     my ($ip)  = @_;
@@ -102,7 +117,7 @@
     my $self = shift;
     my $cmd  = shift;
 
-    $cmd =~ s/[^A-Z\d]//g;
+    $cmd =~ s/[^A-Z\d]//ig;
 
     $self->{job} = ++$self->{job} % 255;    # cap the job id on 255;
     $cmd = $STX . sprintf("%02x", $self->{job}) . $cmd;    # add STX and job id