File Coverage

blib/lib/Device/Modbus/TCP/ADU.pm
Criterion Covered Total %
statement 33 33 100.0
branch 11 12 91.6
condition 3 3 100.0
subroutine 9 9 100.0
pod 0 5 0.0
total 56 62 90.3


line stmt bran cond sub pod time code
1             package Device::Modbus::TCP::ADU;
2              
3 18     18   29196 use parent 'Device::Modbus::ADU';
  18         51  
  18         139  
4 18     18   20844 use Carp;
  18         48  
  18         1081  
5 18     18   142 use strict;
  18         58  
  18         415  
6 18     18   5350 use warnings;
  18         214  
  18         7590  
7              
8             sub id {
9 28     28 0 2117 my ($self, $value) = @_;
10 28 100       124 if (defined $value) {
11 11         94 $self->{id} = $value;
12             }
13             croak "ID has not been declared"
14 28 100       297 unless exists $self->{id};
15 27         124 return $self->{id};
16             }
17              
18             sub length {
19 8     8 0 1370 my ($self, $value) = @_;
20 8 100       231 if (defined $value) {
21 6         37 $self->{length} = $value;
22             }
23             croak "PDU length has not been declared"
24 8 100       114 unless exists $self->{length};
25 7         24 return $self->{length};
26             }
27              
28             # Modbus TCP states unit number is 0xFF by default
29             sub unit {
30 41     41 0 1711 my $self = shift;
31 41 100 100     257 $_[0] = 0xFF unless exists $self->{unit} || defined $_[0];
32 41         244 return $self->SUPER::unit(@_);
33             }
34              
35             sub binary_message {
36 11     11 0 42 my $self = shift;
37 11 50       41 croak "Please include a unit number in the ADU."
38             unless $self->unit;
39 11         172 my $header = $self->build_header;
40 11         41 my $pdu = $self->message->pdu();
41 11         330 return $header . $pdu;
42             }
43              
44             #### APU building
45              
46             sub build_header {
47 12     12 0 428 my $self = shift;
48 12         55 my $header = pack 'nnnC',
49             $self->id, # Transaction id
50             0x0000, # Protocol number (Modbus)
51             CORE::length($self->message->pdu) + 1, # Length of PDU + 1 byte for unit
52             $self->unit; # Unit number
53 12         183 return $header;
54             }
55              
56             1;