File Coverage

blib/lib/Device/USB/TEMPer1F.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


line stmt bran cond sub pod time code
1              
2             # USB Dongle TEMPer1F
3             # The Dongle has Vendor ID 0x0C45 and Product ID 0x7401
4              
5             package Device::USB::TEMPer1F;
6              
7             our $VERSION = '0.02';
8              
9 1     1   13776 use 5.008008;
  1         3  
10 1     1   5 use strict;
  1         1  
  1         16  
11 1     1   2 use warnings;
  1         8  
  1         21  
12 1     1   289 use Device::USB;
  0            
  0            
13              
14             sub new{
15             my $class = shift;
16              
17             # Basic Configuration
18             my %cfg = (
19             vid => 0x0C45, # Vendor ID
20             pid => 0x7401, # Product ID
21             tim => 500, # Timeout
22             epi => 0x82, # Endoint in
23             );
24              
25             my $self = bless{
26             cfg => \%cfg,
27             buffer => 0
28             }, $class;
29            
30             # There are two devices!
31             # Need the device having:
32             # bInterfaceProtocol = 2
33             # and
34             # bInterfaceNumber = 1
35             return eval{
36             my $usb = Device::USB->new;
37             my $device = undef;
38             foreach my $d( $usb->list_devices ){
39             next if $d->idVendor != $cfg{vid};
40             next if $d->idProduct != $cfg{pid};
41              
42             foreach my $cfg( $d->config ){
43             foreach my $ifs( $cfg->interfaces ){
44             foreach my $if( @$ifs ){
45             if( $if->bInterfaceNumber == 1 ){
46             $device = $d;
47             last;
48             }
49             }
50             }
51             }
52             }
53              
54             die "Device TEMPer1F not found!\n" unless $device;
55             $device->open() or die "Can not open the device TEMPer1F!\n";
56             0 == $device->set_configuration(1) ||
57             die "Cannot set configuration for device TEMPer1F!\n";
58             0 == $device->claim_interface(1) ||
59             die "Cannot claim interface 1 for device TEMPer1F!\n";
60              
61             $self->{device} = $device;
62             $self;
63             }
64             }
65              
66              
67             # fetch temperature in °C
68             sub fetch{
69             my $self = shift;
70             $self->_control();
71             $self->{device}->interrupt_read($self->{cfg}{epi},$self->{buffer},8,$self->{cfg}{tim});
72              
73             my $r = [unpack "C8", $self->{buffer}];
74             return sprintf "%0.2f", $r->[4] + $r->[5]/256;
75             }
76              
77             ############################ private methods ##############################
78             # set up a control message
79             sub _control{
80             my $self = shift;
81             my $buffer = pack("C8", 0x1,0x80,0x33,0x1,0x0,0x0,0x0,0x0);
82             my $check = $self->{device}->control_msg(
83             0x21,
84             0x09,
85             0x0200,
86             0x01,
87             $buffer,
88             8,
89             $self->{cfg}{tim}
90             );
91             die "Cannot setup a control_message!\n" if $check != 8;
92             }
93              
94             1;#########################################################################
95             # my $temper = Device::USB::TEMPer1F->new or die $@;
96             # print $temper->fetch;
97             __END__