File Coverage

blib/lib/Sys/Statistics/Linux/SockStats.pm
Criterion Covered Total %
statement 30 31 96.7
branch 13 16 81.2
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 50 54 92.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Sys::Statistics::Linux::SockStats - Collect linux socket statistics.
4              
5             =head1 SYNOPSIS
6              
7             use Sys::Statistics::Linux::SockStats;
8              
9             my $lxs = Sys::Statistics::Linux::SockStats->new;
10             my $stat = $lxs->get;
11              
12             =head1 DESCRIPTION
13              
14             Sys::Statistics::Linux::SockStats gathers socket statistics from the virtual F filesystem (procfs).
15              
16             For more information read the documentation of the front-end module L.
17              
18             =head1 SOCKET STATISTICS
19              
20             Generated by F.
21              
22             used - Total number of used sockets.
23             tcp - Number of tcp sockets in use.
24             udp - Number of udp sockets in use.
25             raw - Number of raw sockets in use.
26             ipfrag - Number of ip fragments in use (only available by kernels > 2.2).
27              
28             =head1 METHODS
29              
30             =head2 new()
31              
32             Call C to create a new object.
33              
34             my $lxs = Sys::Statistics::Linux::SockStats->new;
35              
36             It's possible to set the path to the proc filesystem.
37              
38             Sys::Statistics::Linux::SockStats->new(
39             files => {
40             # This is the default
41             path => '/proc',
42             sockstat => 'net/sockstat',
43             }
44             );
45              
46             =head2 get()
47              
48             Call C to get the statistics. C returns the statistics as a hash reference.
49              
50             my $stat = $lxs->get;
51              
52             =head1 EXPORTS
53              
54             No exports.
55              
56             =head1 SEE ALSO
57              
58             B
59              
60             =head1 REPORTING BUGS
61              
62             Please report all bugs to .
63              
64             =head1 AUTHOR
65              
66             Jonny Schulz .
67              
68             =head1 COPYRIGHT
69              
70             Copyright (c) 2006, 2007 by Jonny Schulz. All rights reserved.
71              
72             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
73              
74             =cut
75              
76             package Sys::Statistics::Linux::SockStats;
77              
78 1     1   6 use strict;
  1         2  
  1         41  
79 1     1   6 use warnings;
  1         2  
  1         37  
80 1     1   6 use Carp qw(croak);
  1         2  
  1         646  
81              
82             our $VERSION = '0.09';
83              
84             sub new {
85 1     1 1 3 my $class = shift;
86 1 50       4 my $opts = ref($_[0]) ? shift : {@_};
87              
88 1         6 my %self = (
89             files => {
90             path => '/proc',
91             sockstat => 'net/sockstat',
92             }
93             );
94              
95 1         1 foreach my $file (keys %{ $opts->{files} }) {
  1         6  
96 0         0 $self{files}{$file} = $opts->{files}->{$file};
97             }
98              
99 1         7 return bless \%self, $class;
100             }
101              
102             sub get {
103 1     1 1 3 my $self = shift;
104 1         3 my $class = ref $self;
105 1         5 my $file = $self->{files};
106 1         2 my %socks = ();
107              
108 1 50       9 my $filename = $file->{path} ? "$file->{path}/$file->{sockstat}" : $file->{sockstat};
109 1 50       62 open my $fh, '<', $filename or croak "$class: unable to open $filename ($!)";
110              
111 1         9660 while (my $line = <$fh>) {
112 6 100       42 if ($line =~ /sockets: used (\d+)/) {
    100          
    100          
    100          
    100          
113 1         9 $socks{used} = $1;
114             } elsif ($line =~ /TCP: inuse (\d+)/) {
115 1         7 $socks{tcp} = $1;
116             } elsif ($line =~ /UDP: inuse (\d+)/) {
117 1         5 $socks{udp} = $1;
118             } elsif ($line =~ /RAW: inuse (\d+)/) {
119 1         6 $socks{raw} = $1;
120             } elsif ($line =~ /FRAG: inuse (\d+)/) {
121 1         10 $socks{ipfrag} = $1;
122             }
123             }
124              
125 1         17 close($fh);
126 1         13 return \%socks;
127             }
128              
129             1;