Implemented get(), on(), off().
But it's not tested a lot! So, you're warned.
--- 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>