File Coverage

blib/lib/Metabrik/System/Netstat.pm
Criterion Covered Total %
statement 9 38 23.6
branch 0 8 0.0
condition 0 6 0.0
subroutine 3 6 50.0
pod 1 3 33.3
total 13 61 21.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # system::netstat Brik
5             #
6             package Metabrik::System::Netstat;
7 1     1   690 use strict;
  1         3  
  1         29  
8 1     1   6 use warnings;
  1         1  
  1         27  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command);
  1         2  
  1         555  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable listen) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             commands => {
19             udp_listen => [ ],
20             tcp_listen => [ ],
21             },
22             require_binaries => {
23             'netstat', => [ ],
24             },
25             };
26             }
27              
28             sub udp_listen {
29 0     0 0   my $self = shift;
30              
31 0           $self->as_array(0);
32 0           $self->as_matrix(1);
33 0           my $lines = $self->capture("netstat -an");
34              
35 0           my $listen = { };
36 0           for my $line (@$lines) {
37 0           my $proto = $line->[0];
38 0 0         if ($proto eq 'udp') {
39 0           $proto = 'udp4'; # Rewrite for FreeBSD and uniformity
40             }
41 0 0 0       if ($proto eq 'udp4' || $line->[0] eq 'udp6') {
42 0           my $ip_port = $line->[3];
43 0           my ($ip, $port) = $ip_port =~ /^(.*)[:\.](\d+)$/; # : is Linux separator, . is FreeBSD one
44 0           $listen->{$proto}->{$ip_port} = { ip => $ip, port => $port };
45             }
46             }
47              
48 0           return $listen;
49             }
50              
51             sub tcp_listen {
52 0     0 0   my $self = shift;
53              
54 0           $self->as_array(0);
55 0           $self->as_matrix(1);
56 0           my $lines = $self->capture("netstat -an");
57              
58 0           my $listen = { };
59 0           for my $line (@$lines) {
60 0           my $proto = $line->[0];
61 0 0         if ($proto eq 'tcp') {
62 0           $proto = 'tcp4'; # Rewrite for FreeBSD and uniformity
63             }
64 0 0 0       if ($proto eq 'tcp4' || $proto eq 'tcp6') {
65 0           my $ip_port = $line->[3];
66 0           my ($ip, $port) = $ip_port =~ /^(.*)[:\.](\d+)$/; # : is Linux separator, . is FreeBSD one
67 0           $listen->{$proto}->{$ip_port} = { ip => $ip, port => $port };
68             }
69             }
70              
71 0           return $listen;
72             }
73              
74             1;
75              
76             __END__