File Coverage

blib/lib/Device/USB/MissileLauncher/RocketBaby.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Device::USB::MissileLauncher::RocketBaby;
2 1     1   19749 use strict;
  1         2  
  1         39  
3 1     1   5 use warnings;
  1         2  
  1         29  
4 1     1   431 use Device::USB;
  0            
  0            
5              
6             our $VERSION = '1.01';
7              
8             sub new
9             {
10             my ($class) = @_;
11              
12             my $usb = Device::USB->new;
13             my $dev = $usb->find_device(0xA81, 0x701);
14             $dev->open;
15             $dev->detach_kernel_driver_np(0);
16             $dev->set_configuration(1);
17             $dev->claim_interface(0);
18              
19             bless { dev => $dev }, $class;
20             }
21              
22             sub _send
23             {
24             my ($self, $val) = @_;
25             $self->{dev}->control_msg(0x21, 0x09, 0x02, 0, chr($val), 1, 1000);
26             }
27              
28             sub _stat
29             {
30             my ($self) = @_;
31             $self->_send(0x40);
32             $self->{dev}->bulk_read(1, my $buf = "\0", 1, 1000);
33             ord($buf);
34             }
35              
36             sub _cando
37             {
38             my ($self, $val) = @_;
39             not $self->_stat & $val;
40             }
41              
42             my %VAL = (
43             down => 0x01,
44             up => 0x02,
45             left => 0x04,
46             right => 0x08,
47             fire => 0x10,
48             stop => 0x20,
49             );
50              
51             sub _val { $VAL{$_[1]} }
52              
53             sub cando
54             {
55             my ($self, $cmd) = @_;
56             my $val = $self->_val($cmd) or return;
57             $self->_cando($val);
58             }
59              
60             sub do
61             {
62             my ($self, $cmd) = @_;
63             my $val = $self->_val($cmd) or return -1;
64             $self->_send($val);
65             }
66              
67             1;
68              
69             __END__