|
1 #! /usr/bin/perl |
|
2 |
|
3 # should probably called on blib environment: |
|
4 # perl -Mblib examples/client ... |
|
5 |
|
6 use strict; |
|
7 use warnings; |
|
8 use Quancom; |
|
9 use Time::HiRes qw(usleep); |
|
10 use Data::Dumper; |
|
11 |
|
12 MAIN: { |
|
13 |
|
14 my @q; |
|
15 tie @q => "Quancom", $ARGV[0]; |
|
16 |
|
17 $q[0] = 1; |
|
18 print $q[7], "\n"; |
|
19 print $q[6], "\n"; |
|
20 print scalar @q; |
|
21 |
|
22 } |
|
23 |
|
24 __END__ |
|
25 |
|
26 my $q = new Quancom $ARGV[0]; |
|
27 |
|
28 my $r; |
|
29 |
|
30 $q->set(1..64 => 1); sleep 1; |
|
31 print $q->get(1..64), "\n"; |
|
32 $q->set(1..64 => 0); sleep 1; |
|
33 print $q->get(1..64), "\n"; |
|
34 |
|
35 foreach (1..64) { |
|
36 $q->set($_ => 1); |
|
37 print $q->get(1..64), "\n"; |
|
38 usleep 1e6/20; |
|
39 } |
|
40 foreach (1..64) { |
|
41 $q->set($_ => 0); |
|
42 print $q->get(1..64), "\n"; |
|
43 usleep 1e6/20; |
|
44 } |
|
45 |
|
46 # reset |
|
47 $q->full_reset->ok or warn "err: " . $q->last_result->error_message . "\n"; |
|
48 |
|
49 # does not work |
|
50 #$q->cmd("RB 0007")->ok or die $q->last_result->error_message; |
|
51 #print "***: " . $q->last_result->data . "\n"; |
|
52 #$q->set_timeout(5)->ok or die $q->last_result->error_message; |
|
53 #$q->cmd("WB 0100 FF")->ok or die $q->last_result->error_message; |
|
54 #$q->cmd("RB 0007")->ok or die $q->last_result->error_message; |
|
55 #print "***: " . $q->last_result->data . "\n"; |
|
56 #exit; |
|
57 |
|
58 foreach ( |
|
59 qw( |
|
60 WX.0100.FF.FF.FF.FF.FF.FF.FF.FF |
|
61 WX.0100.00.00.00.00.00.00.00.00 |
|
62 WB.0100.FF |
|
63 WB.0100.01 |
|
64 WB.0100.55 |
|
65 WB.0100.AA |
|
66 WL.0100.00.55.00.55 |
|
67 SL.0100.00.55.00.55 |
|
68 CL.0100.00.55.00.55 |
|
69 WX.0100.FF.FF.FF.FF.FF.FF.FF.FF |
|
70 ) |
|
71 ) |
|
72 { |
|
73 $r = $q->cmd($_); |
|
74 print "err: " . $r->error_message . "\n" if not $r->ok; |
|
75 |
|
76 /.(.)\.(....)/; |
|
77 $r = $q->cmd("R$1$2"); |
|
78 if ($r->ok) { |
|
79 print "got: " . $r->data . "\n"; |
|
80 } |
|
81 else { |
|
82 print "err: " . $r->error_message . "\n" if not $r->ok; |
|
83 } |
|
84 sleep 1; |
|
85 } |
|
86 |
|
87 } |
|
88 |