File Coverage

blib/lib/Metabrik/Network/Modbus.pm
Criterion Covered Total %
statement 9 23 39.1
branch 0 8 0.0
condition 0 5 0.0
subroutine 3 5 60.0
pod 1 2 50.0
total 13 43 30.2


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::modbus Brik
5             #
6             package Metabrik::Network::Modbus;
7 1     1   710 use strict;
  1         2  
  1         29  
8 1     1   6 use warnings;
  1         2  
  1         29  
9              
10 1     1   5 use base qw(Metabrik::Client::Tcp);
  1         2  
  1         269  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             commands => {
19             probe => [ qw(host port|OPTIONAL) ],
20             },
21             };
22             }
23              
24             sub probe {
25 0     0 0   my $self = shift;
26 0           my ($host, $port) = @_;
27              
28 0   0       $host ||= $self->host;
29 0   0       $port ||= 502;
30 0 0         $self->brik_help_run_undef_arg('probe', $host) or return;
31              
32             # XXX: gather nmap --script modbus-discovery -p 502
33              
34             # To port 502/TCP (from plcscan)
35 0           my $probe =
36             "\x00\x00\x00\x00\x00\x05\x00\x2b".
37             "\x0e\x01\x00";
38              
39 0           $self->host($host);
40 0           $self->port($port);
41 0 0         $self->connect or return;
42 0 0         $self->write($probe) or return;
43 0 0         my $response = $self->read or return;
44 0           $self->disconnect;
45              
46 0           return $response;
47             }
48              
49             1;
50              
51             __END__