Bug. Timeout.
But the set_timeout() does not work as expected. Needs more
investigation. Or better documentation on Quancom pages.
--- 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;
--- 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;
}
}
--- 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