# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1233026001 -3600
# Node ID a48c1d372ad4c90ea92b163eb15a62ad69adfb8b
# Parent  66c21518904c3bb7bcef8b7eef9609f977ee5555
Added limited support for a tied array.

my @q;
tie @q, Quancom  => "127.0.0.1";
$q[0] = 1;
print $q[7;

diff -r 66c21518904c -r a48c1d372ad4 examples/client2
--- /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;
+    }
+
+}
+
diff -r 66c21518904c -r a48c1d372ad4 lib/Quancom.pm
--- 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__