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 7     7   101458 use parent 'Device::Modbus::Client';
  7         1547  
  7         28  
4 7     7   48629 use Role::Tiny::With;
  7         22988  
  7         273  
5 7     7   28 use Carp;
  7         7  
  7         266  
6 7     7   28 use strict;
  7         7  
  7         98  
7 7     7   21 use warnings;
  7         7  
  7         1596  
8              
9             with 'Device::Modbus::TCP';
10              
11             sub new {
12 1     1 1 1379 my ($class, %args) = @_;
13              
14 1   50     19 $args{host} //= '127.0.0.1';
15 1   50     9 $args{port} //= 502;
16 1   50     16 $args{timeout} //= 2;
17              
18 1         8 return bless \%args, $class;
19             }
20              
21             sub socket {
22 11     11 1 10 my $self = shift;
23 11 100       20 if (@_) {
24 1         2 $self->{socket} = shift;
25             }
26 11 100       20 if (!defined $self->{socket}) {
27 1 50       4 $self->_build_socket || croak "Unable to open a connection";
28             }
29 11         32 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 1     1   1 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 1         17 Proto => 'tcp',
45             );
46 1 50       2743 return undef unless $sock;
47 1         12 $self->socket($sock);
48 1         2 return 1;
49             }
50              
51             #### Transaction ID
52             my $trans_id = 0;
53              
54             sub next_trn_id {
55 1     1 0 14 my $self = shift;
56 1         2 $trans_id++;
57 1 50       6 $trans_id = 1 if $trans_id > 65_535;
58 1         6 return $trans_id;
59             }
60              
61             1;
62              
63             __END__