File Coverage

blib/lib/Device/Modbus/TCP/Client.pm
Criterion Covered Total %
statement 35 37 94.5
branch 7 10 70.0
condition 3 9 33.3
subroutine 9 10 90.0
pod 3 4 75.0
total 57 70 81.4


line stmt bran cond sub pod time code
1             package Device::Modbus::TCP::Client;
2              
3 17     17   374490 use parent 'Device::Modbus::Client';
  17         4996  
  17         112  
4 17     17   156472 use Role::Tiny::With;
  17         105299  
  17         1363  
5 17     17   183 use Carp;
  17         51  
  17         2441  
6 17     17   149 use strict;
  17         47  
  17         467  
7 17     17   118 use warnings;
  17         54  
  17         6061  
8              
9             with 'Device::Modbus::TCP';
10              
11             sub new {
12 3     3 1 6629 my ($class, %args) = @_;
13              
14 3   50     88 $args{host} //= '127.0.0.1';
15 3   50     19 $args{port} //= 502;
16 3   50     88 $args{timeout} //= 2;
17              
18 3         42 return bless \%args, $class;
19             }
20              
21             sub socket {
22 26     26 1 2000443 my $self = shift;
23 26 100       108 if (@_) {
24 3         16 $self->{socket} = shift;
25             }
26 26 100       130 if (!defined $self->{socket}) {
27 3 50       36 $self->_build_socket || croak "Unable to open a connection";
28             }
29 26         173 return $self->{socket};
30             }
31              
32             sub connected {
33 0     0 1 0 my $self = shift;
34 0   0     0 return defined $self->{socket} && $self->{socket}->connected;
35             }
36              
37             sub _build_socket {
38 3     3   13 my $self = shift;
39             my $sock = IO::Socket::INET->new(
40             PeerAddr => $self->{host},
41             PeerPort => $self->{port},
42             Blocking => $self->{blocking},
43             Timeout => $self->{timeout},
44 3         91 Proto => 'tcp',
45             );
46 3 50       9742 return undef unless $sock;
47 3         25 $self->socket($sock);
48 3         17 return 1;
49             }
50              
51             #### Transaction ID
52             my $trans_id = 0;
53              
54             sub next_trn_id {
55 3     3 0 11 my $self = shift;
56 3         14 $trans_id++;
57 3 50       22 $trans_id = 1 if $trans_id > 65_535;
58 3         26 return $trans_id;
59             }
60              
61             1;
62              
63             __END__