Improved example. More simplified usage of example.
--- 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";
}
--- 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.
--- 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](..)(.*)(..)$/) {
--- 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 {