File Coverage

blib/lib/Device/BlinkStick.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition 1 2 50.0
subroutine 7 7 100.0
pod n/a
total 27 30 90.0


line stmt bran cond sub pod time code
1              
2             # ABSTRACT:
3              
4             =head1 NAME
5              
6             Device::BlinkStick
7              
8             =head1 SYNOPSIS
9              
10             use 5.10.0 ;
11             use strict ;
12             use warnings ;
13             use Device::BlinkStick;
14              
15             my $bs = Device::BlinkStick->new() ;
16              
17             # set first LED on all devices to blue
18             my $all_devices = $bs->devices() ;
19             foreach my $k ( keys %$all_devices) {
20             $all->{$k}->set_color( 'blue') ;
21             }
22              
23             # get the first blinkstick found
24             my $device = $bs->first() ;
25             # make it red
26             $first->led( color => 'red') ;
27              
28             sleep( 2) ;
29             # blink red for 5 times, delaying for 250ms between black and the color
30             $first->blink( color => 'red', delay => 250, times => 5) ;
31              
32             =head1 DESCRIPTION
33              
34             Module to control a number of blinkstick devices L connected via USB.
35              
36             =cut
37              
38             package Device::BlinkStick ;
39             $Device::BlinkStick::VERSION = '0.4.0';
40 1     1   20748 use 5.014 ;
  1         4  
41 1     1   5 use warnings ;
  1         2  
  1         26  
42 1     1   5 use strict ;
  1         5  
  1         33  
43              
44             # we need to set the PERL_INLINE_DIRECTORY environment variable to something
45             # not in the current directory BEFORE we load Device::USB
46             BEGIN {
47 1     1   1238 use Path::Tiny ;
  1         13250  
  1         138  
48            
49 1   50 1   932 my $user = getlogin || getpwuid($<) || "anyone";
50              
51 1         16 $ENV{PERL_INLINE_DIRECTORY} = "/tmp/_Inline/$user/" . __PACKAGE__ ;
52 1         8 $ENV{PERL_INLINE_DIRECTORY} =~ s/::/_/g ;
53             # make sure the directory exists
54 1         5 path( $ENV{PERL_INLINE_DIRECTORY})->mkpath() ;
55             }
56              
57 1     1   2019 use Moo ;
  1         198395  
  1         9  
58 1     1   6730 use Device::USB ;
  0            
  0            
59             use Device::BlinkStick::Stick ;
60              
61              
62             # ----------------------------------------------------------------------------
63              
64             use constant VENDOR_ID => 0x20a0 ;
65             use constant PRODUCT_ID => 0x41e5 ;
66             use constant UPDATE_TIME => 2 ;
67              
68             # ----------------------------------------------------------------------------
69              
70             # mapping of serial IDs to device info
71             has devices => ( is => 'ro', init_arg => 0 ) ;
72             # the first device found
73             has first => ( is => 'ro', init_arg => 0 ) ;
74             has verbose => ( is => 'ro' ) ;
75             has inverse => ( is => 'ro' ) ;
76             has _last_refresh => ( is => 'ro', init_arg => 0, default => sub { 0 } );
77              
78             # ----------------------------------------------------------------------------
79              
80             =head2 new
81              
82             Instantiate a new object, also finds all currently connected devices and populates
83             the accessor method variables
84              
85             =head3 parameters
86              
87             =over 4
88              
89             =item verbose
90              
91             output some debug as things happen
92              
93             =back
94              
95             =head3 access methods
96              
97             =over 4
98              
99             =item devices
100              
101             Get all blinkstick device L objects available as a hash ref
102              
103             my $bs = Device::BlinkStick->new() ;
104             my $devices = $bs->devices() ;
105              
106             =item first
107              
108             Get the first blink stick device (object L) found
109              
110             my $bs = Device::BlinkStick->new() ;
111             my $device = $bs->first() ;
112             # make it red
113             $first->led( color => 'red') ;
114              
115             =back
116              
117             =cut
118              
119             sub BUILD
120             {
121             my $self = shift ;
122             my $args = shift ;
123              
124             # find the sticks
125             $self->refresh_devices() ;
126             }
127              
128             # ----------------------------------------------------------------------------
129             # find all the connected blinkstick devices
130              
131             =head2 refresh_devices
132              
133             Check the USB for any added or removed devices and update our internal list
134              
135             Returns all blinkstick device objects available as a hash ref
136              
137             my $bs = Device::BlinkStick->new() ;
138             my $current = $bs->refresh_devices() ;
139              
140             =cut
141              
142             sub refresh_devices
143             {
144             my $self = shift ;
145              
146             # we don't want to update this too often as it takes ~ 0.4s to run
147             if ( !$self->{_last_refresh} || $self->{_last_refresh} + UPDATE_TIME < time() ) {
148             $self->{_last_refresh} = time() ;
149             my $usb = Device::USB->new() ;
150             my @sticks = $usb->list_devices( VENDOR_ID, PRODUCT_ID ) ;
151              
152             # always rebuild the data set
153             $self->{devices} = {} ;
154             delete $self->{first} ;
155              
156             # find all devices
157             if ( scalar(@sticks) ) {
158             $self->{devices} = {} ;
159             foreach my $dev (@sticks) {
160             my $device = Device::BlinkStick::Stick->new(
161             device => $dev,
162             verbose => $self->verbose(),
163             inverse => $self->inverse()
164             ) ;
165             if ( !$self->{first} ) {
166             $self->{first} = $device ;
167             }
168             # build the mapping of devices
169             $self->{devices}->{ lc( $device->serial_number() ) }
170             = $device ;
171             }
172             }
173             }
174              
175             return $self->{devices} ;
176             }
177              
178             # ----------------------------------------------------------------------------
179             # find a matching device
180              
181             =head2 find
182              
183             Find a device by name or serial number
184              
185             my $bs = Device::BlinkStick->new() ;
186             my $d = $bs->find( 'strip') ; # I have a device I've named strip!
187             $d->set_mode( 3) ;
188             $d->led( color => 'green') ; # set all LEDs to green
189              
190             =over 4
191              
192             =item name
193              
194             The name or serial number to match
195              
196             =back
197              
198             Returns undef if fails to match a device
199              
200             =cut
201              
202             sub find
203             {
204             my $self = shift ;
205             my ($name) = @_ ;
206             my $stick ;
207              
208             $name = lc($name) ;
209             # check match on serial number
210             if ( $self->{devices}->{$name} ) {
211             $stick = $self->{devices}->{$name};
212             } else {
213             # match against each device name
214             foreach my $s ( keys %{ $self->{devices} } ) {
215             if ( lc( $self->{devices}->{$s}->device_name ) eq $name ) {
216             $stick = $self->{devices}->{$s} ;
217             }
218             }
219             }
220             return $stick ;
221             }
222              
223             # ----------------------------------------------------------------------------
224             1 ;
225