File Coverage

blib/lib/Metabrik/Network/S7comm.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::s7comm Brik
5             #
6             package Metabrik::Network::S7comm;
7 1     1   898 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         42  
9              
10 1     1   7 use base qw(Metabrik::Client::Tcp);
  1         3  
  1         332  
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 ||= 102;
30 0 0         $self->brik_help_run_undef_arg('probe', $host) or return;
31              
32             # To port 102/TCP (from plcscan)
33 0           my $probe =
34             "\x03\x00\x00\x16\x11\xe0\x00\x00".
35             "\x00\x0b\x00\xc1\x02\x01\x00\xc2".
36             "\x02\x01\x02\xc0\x01\x0a";
37              
38 0           $self->host($host);
39 0           $self->port($port);
40 0 0         $self->connect or return;
41 0 0         $self->write($probe) or return;
42 0 0         my $response = $self->read or return;
43 0           $self->disconnect;
44              
45 0           return $response;
46             }
47              
48             1;
49              
50             __END__