File Coverage

blib/lib/Linux/Statm/Tiny.pm
Criterion Covered Total %
statement 26 26 100.0
branch 1 2 50.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 35 36 97.2


line stmt bran cond sub pod time code
1             package Linux::Statm::Tiny;
2              
3 3     3   2202 use v5.10.1;
  3         12  
4              
5 3     3   1582 use Moo;
  3         33605  
  3         15  
6 3     3   5603 use MooX::Aliases;
  3         15092  
  3         17  
7              
8 3     3   1095 use Fcntl qw/ O_RDONLY /;
  3         7  
  3         157  
9 3     3   1016 use POSIX qw/ ceil /;
  3         12956  
  3         19  
10 3     3   4842 use Types::Standard qw/ ArrayRef Int /;
  3         224151  
  3         35  
11              
12             our $VERSION = '0.0601';
13              
14             # ABSTRACT: simple access to Linux /proc/../statm
15              
16              
17             has pid => (
18             is => 'lazy',
19             isa => Int,
20             default => sub { $$ },
21             );
22              
23              
24             my $PageSize;
25              
26             has page_size => (
27             is => 'lazy',
28             isa => Int,
29             default => sub {
30             $PageSize //= `getconf PAGE_SIZE`
31             or die "Unable to run getconf PAGE_SIZE: $!";
32             $PageSize += 0;
33             },
34             init_arg => undef,
35             );
36              
37              
38             has statm => (
39             is => 'lazy',
40             isa => ArrayRef[Int],
41             writer => 'refresh',
42             init_arg => undef,
43             );
44              
45             sub _build_statm {
46 2     2   1475 my ($self) = @_;
47 2         59 my $pid = $self->pid;
48 2 50       252 sysopen( my $fh, "/proc/${pid}/statm", O_RDONLY )
49             or die "Unable to open /proc/${pid}/statm: $!";
50 2         40 chomp(my $raw = <$fh>);
51 2         25 close $fh;
52 2         81 [ split / /, $raw ];
53             }
54              
55              
56             my %stats = (
57             size => 0,
58             resident => 1,
59             share => 2,
60             text => 3,
61             lib => 4,
62             data => 5,
63             dt => 6,
64             );
65              
66             my %aliases = (
67             size => 'vsz',
68             resident => 'rss',
69             );
70              
71             my %alts = ( # page_size multipliers
72             bytes => 1,
73             kb => 1024,
74             mb => 1048576,
75             );
76              
77             my @attrs;
78              
79             foreach my $attr (keys %stats) {
80              
81             my @aliases = ( "${attr}_pages" );
82             push @aliases, ( $aliases{$attr}, $aliases{$attr} . '_pages' )
83             if $aliases{$attr};
84              
85             has $attr => (
86             is => 'lazy',
87             isa => Int,
88             default => sub { shift->statm->[$stats{$attr}] },
89             init_arg => undef,
90             alias => \@aliases,
91             clearer => "_refresh_${attr}",
92             );
93              
94             push @attrs, $attr;
95              
96             foreach my $alt (keys %alts) {
97             has "${attr}_${alt}" => (
98             is => 'lazy',
99             isa => Int,
100             default => sub { my $self = shift;
101             ceil($self->$attr * $self->page_size / $alts{$alt});
102             },
103             init_arg => undef,
104             clearer => "_refresh_${attr}_${alt}",
105             $aliases{$attr} ? ( alias => $aliases{$attr} . "_${alt}" ) : ( ),
106             );
107              
108             push @attrs, "${attr}_${alt}";
109             }
110              
111             }
112              
113             around refresh => sub {
114             my ($next, $self) = @_;
115             $self->$next( $self->_build_statm );
116             foreach my $attr (@attrs) {
117             my $meth = "_refresh_${attr}";
118             $self->$meth;
119             }
120             };
121              
122              
123              
124 3     3   6031 use namespace::autoclean 0.16;
  3         40213  
  3         18  
125              
126             1;
127              
128             __END__