examples/client2
branchtied
changeset 24 a48c1d372ad4
parent 23 66c21518904c
--- /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;
+    }
+
+}
+