Added limited support for a tied array.
my @q;
tie @q, Quancom => "127.0.0.1";
$q[0] = 1;
print $q[7;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/client2 Tue Jan 27 04:13:21 2009 +0100
@@ -0,0 +1,88 @@
+#! /usr/bin/perl
+
+# should probably called on blib environment:
+# perl -Mblib examples/client ...
+
+use strict;
+use warnings;
+use Quancom;
+use Time::HiRes qw(usleep);
+use Data::Dumper;
+
+MAIN: {
+
+ my @q;
+ tie @q => "Quancom", $ARGV[0];
+
+ $q[0] = 1;
+ print $q[7], "\n";
+ print $q[6], "\n";
+ print scalar @q;
+
+}
+
+__END__
+
+ my $q = new Quancom $ARGV[0];
+
+ my $r;
+
+ $q->set(1..64 => 1); sleep 1;
+ print $q->get(1..64), "\n";
+ $q->set(1..64 => 0); sleep 1;
+ print $q->get(1..64), "\n";
+
+ foreach (1..64) {
+ $q->set($_ => 1);
+ print $q->get(1..64), "\n";
+ usleep 1e6/20;
+ }
+ foreach (1..64) {
+ $q->set($_ => 0);
+ print $q->get(1..64), "\n";
+ usleep 1e6/20;
+ }
+
+ # reset
+ $q->full_reset->ok or warn "err: " . $q->last_result->error_message . "\n";
+
+ # 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(
+ 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
+ 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;
+ }
+
+}
+
--- a/lib/Quancom.pm Thu Jan 22 04:35:14 2009 +0100
+++ b/lib/Quancom.pm Tue Jan 27 04:13:21 2009 +0100
@@ -84,8 +84,7 @@
sub set {
my $self = shift;
- #my $value = @_ == 1 ? 1 : pop @_ ? 1 : 0;
- croak "need at least 2 values" if @_ < 2;
+ croak "bad usage";
my $value = pop @_ ? 1 : 0;
my @bits = map { $_ - 1 } @_;
my @groups = map { 0 } 0 .. 7;
@@ -175,6 +174,46 @@
return $self->{last_result} = new Quancom::Result($_);
}
+sub TIEARRAY {
+ my $class = shift;
+ my $self = new Quancom @_;
+ return $self;
+}
+
+sub STORE {
+ my $self = shift;
+ warn "@_\n";
+ my ($bit, $value) = @_;
+ $self->set($bit + 1, $value)->ok and return $value;
+ croak "can't set bit $bit to $value";
+}
+
+sub FETCH {
+ my $self = shift;
+ warn "@_\n";
+ my $bit = $_[0];
+ my $value;
+ defined($value = $self->get($bit + 1))
+ and return $value;
+
+ croak "can't get bit $bit\n";
+}
+
+sub PUSH {
+ my $self = shift;
+ warn "@_\n";
+ my @a;
+ @a[0..62] = $self->get(2..64);
+ $a[63] = $_[0];
+ $self->set(@a);
+ return $self->FETCHSIZE;
+}
+
+sub FETCHSIZE {
+ my $self = shift;
+ return 64;
+}
+
1;
__END__