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.03';
8              
9 1     1   14211 use 5.008008;
  1         3  
10 1     1   4 use strict;
  1         2  
  1         20  
11 1     1   3 use warnings;
  1         5  
  1         21  
12 1     1   316 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             if(! ref $self ){
71             $self = __PACKAGE__->new or die $@;
72             }
73            
74             $self->_control();
75             $self->{device}->interrupt_read($self->{cfg}{epi},$self->{buffer},8,$self->{cfg}{tim});
76              
77             my $r = [unpack "C8", $self->{buffer}];
78             return sprintf "%0.2f", $r->[4] + $r->[5]/256;
79             }
80              
81             ############################ private methods ##############################
82             # set up a control message
83             sub _control{
84             my $self = shift;
85             my $buffer = pack("C8", 0x1,0x80,0x33,0x1,0x0,0x0,0x0,0x0);
86             my $check = $self->{device}->control_msg(
87             0x21,
88             0x09,
89             0x0200,
90             0x01,
91             $buffer,
92             8,
93             $self->{cfg}{tim}
94             );
95             die "Cannot setup a control_message!\n" if $check != 8;
96             }
97              
98             1;#########################################################################
99             # my $temper = Device::USB::TEMPer1F->new or die $@;
100             # print $temper->fetch;
101             __END__