Implemented get(), on(), off(). default
authorHeiko Schlittermann <hs@schlittermann.de>
Thu, 22 Jan 2009 04:35:14 +0100
changeset 23 66c21518904c
parent 22 7690e12fafda
child 24 a48c1d372ad4
Implemented get(), on(), off(). But it's not tested a lot! So, you're warned.
examples/client
lib/Quancom.pm
--- a/examples/client	Thu Jan 22 03:57:27 2009 +0100
+++ b/examples/client	Thu Jan 22 04:35:14 2009 +0100
@@ -15,14 +15,18 @@
     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;
     }
 
--- a/lib/Quancom.pm	Thu Jan 22 03:57:27 2009 +0100
+++ b/lib/Quancom.pm	Thu Jan 22 04:35:14 2009 +0100
@@ -82,8 +82,11 @@
 }
 
 sub set {
-    my $self   = shift;
-    my $value  = pop @_ ? 1 : 0;
+    my $self = shift;
+
+    #my $value  = @_ == 1 ? 1 : pop @_ ? 1 : 0;
+    croak "need at least 2 values" if @_ < 2;
+    my $value = pop @_ ? 1 : 0;
     my @bits   = map { $_ - 1 } @_;
     my @groups = map { 0 } 0 .. 7;
 
@@ -96,11 +99,39 @@
     }
 
     my $cmd = $value ? "S" : "C";
+
+    # could be optimized to only include the bytes we're interested
+    # in
     $cmd .= "X 0100";
     $cmd .= join "", map { sprintf "%02x ", $_ } reverse @groups;
     $self->cmd($cmd);
 }
 
+sub on { push @_, 1; goto \&set }
+
+sub off { push @_, 0; goto \&set }
+
+sub get {
+    my $self = shift;
+    my @bits = map { $_ - 1 } @_;
+
+    # could be optimized to only include the bytes we're interested
+    # in
+    $self->cmd("RX 0100")->ok
+      or return undef;
+    my @groups = reverse map { hex } ($self->last_result->data =~ /../g);
+
+    my @r;
+
+    foreach (@bits) {
+        my $group = int($_ / 8);
+        my $bit   = $_ % 8;
+        push @r, $groups[$group] & (1 << $bit) ? 1 : 0;
+    }
+
+    return @bits == 1 ? $r[0] : @r;
+}
+
 sub set_timeout {
     my $self = shift;
     my $to   = shift;
@@ -179,6 +210,19 @@
 
 This sets one or more bits the specified values (true, false).
 
+=item B<get>( $bit, ... )
+
+Return the values of the specified bits. If you provide a list of bits,
+you'll get a list of values, if you provide just a single bit, you'll
+get a single scalar only. On error it returns B<undef>. So for a single
+scalar you've to check carefully if you got 0 or undef.
+
+=item B<on>( $bit, ... )
+
+=item B<off>( $bit, ... )
+
+Both are just shortcuts for L<set>().
+
 =item B<cmd>( I<string> )
 
 Send a Quancom string to the device. The string here should be
@@ -231,6 +275,16 @@
     $quancom->set(1..63 => 1)->ok 
 	or die $quancom->last_result->error_message;
 
+    $quancom->on(33);
+    $quancom->off(33);
+
+    @a = $quancom->get(1..64) or 
+	die $quancom->last_result->error_message;
+    ($a23, $a34) = $quancom->get(23, 34);
+
+    defined($a = $quancom->get(12))
+	or die $quancom->last_result->error_message;
+
 =head1 SEE ALSO
 
 L<Quancom::Result>