File Coverage

blib/lib/Linux/Proc/Maps.pm
Criterion Covered Total %
statement 42 64 65.6
branch 13 36 36.1
condition 4 11 36.3
subroutine 10 12 83.3
pod 4 4 100.0
total 73 127 57.4


line stmt bran cond sub pod time code
1             package Linux::Proc::Maps;
2             # ABSTRACT: Read and write /proc/[pid]/maps files
3             # KEYWORDS: linux proc procfs
4              
5 1     1   29142 use 5.008;
  1         2  
6 1     1   4 use warnings;
  1         2  
  1         23  
7 1     1   4 use strict;
  1         3  
  1         38  
8              
9             our $VERSION = '0.002'; # VERSION
10              
11 1     1   4 use Carp qw(croak);
  1         1  
  1         64  
12 1     1   3 use Exporter qw(import);
  1         2  
  1         31  
13 1     1   491 use namespace::clean -except => [qw(import)];
  1         13457  
  1         7  
14              
15             our @EXPORT_OK = qw(read_maps write_maps parse_maps_single_line format_maps_single_line);
16              
17              
18             sub read_maps {
19 3 100   3 1 12010 my %args = @_ == 1 ? (pid => $_[0]) : @_;
20              
21 3         6 my $file = $args{file};
22              
23 3 100 66     29 if (!$file and my $pid = $args{pid}) {
24 2 50       16 if ($pid =~ /^\d+$/) {
25 0         0 require File::Spec::Functions;
26             my $procfs = $args{mnt} || $ENV{PERL_LINUX_PROC_MAPS_MOUNT} ||
27 0   0     0 File::Spec::Functions::catdir(File::Spec::Functions::rootdir(), 'proc');
28 0         0 $file = File::Spec::Functions::catfile($procfs, $pid, 'maps');
29             }
30             else {
31 2         9 $file = $args{pid};
32             }
33             }
34              
35 3 100       144 $file or croak 'Filename or PID required';
36 1 100   1   5 open(my $fh, '<:encoding(UTF-8)', $file) or croak "Open failed ($file): $!";
  1         2  
  1         6  
  2         40  
37              
38 1         191 my @regions;
39              
40 1         23 while (my $line = <$fh>) {
41 20         103 chomp $line;
42              
43 20         25 my $region = parse_maps_single_line($line);
44 20 50       35 next if !$region;
45              
46 20         70 push @regions, $region;
47             }
48              
49 1         20 return \@regions;
50             }
51              
52              
53             sub write_maps {
54 0 0   0 1 0 my $regions = shift or croak 'Regions required';
55 0         0 my %args = @_;
56              
57 0 0       0 ref $regions eq 'ARRAY' or croak 'Regions must be an arrayref';
58              
59 0         0 my $out = '';
60              
61 0         0 for my $region (@$regions) {
62 0         0 $out .= format_maps_single_line($region);
63             }
64              
65             # maybe print out the memory regions to a filehandle
66 0         0 my $fh = $args{fh};
67 0 0 0     0 if (!$fh and my $file = $args{file}) {
68 0 0       0 open($fh, '>:encoding(UTF-8)', $file) or croak "Open failed ($file): $!";
69             }
70 0 0       0 print $fh $out if $fh;
71              
72 0         0 return $out;
73             }
74              
75              
76             sub parse_maps_single_line {
77 24 50   24 1 4572 my $line = shift or croak 'Line from a maps file required';
78              
79 24         24 chomp $line;
80              
81 24         160 my ($addr1, $addr2, $read, $write, $exec, $shared, $offset, $device, $inode, $pathname) = $line =~ m{
82             ^
83             ([[:xdigit:]]+)-([[:xdigit:]]+)
84             \s+ ([r-])([w-])([x-])([sp])
85             \s+ ([[:xdigit:]]+)
86             \s+ ([[:xdigit:]]+:[[:xdigit:]]+)
87             \s+ (\d+)
88             (?: \s+ (.*))?
89             }x;
90              
91 24 100       43 return if !$addr1;
92              
93 1     1   725 no warnings 'portable'; # for hex() on 64-bit perls
  1         1  
  1         197  
94              
95             return {
96 23   100     183 address_start => hex($addr1),
97             address_end => hex($addr2),
98             read => 'r' eq $read,
99             write => 'w' eq $write,
100             execute => 'x' eq $exec,
101             shared => 's' eq $shared,
102             offset => hex($offset),
103             device => $device,
104             inode => $inode,
105             pathname => $pathname || '',
106             };
107             }
108              
109              
110             sub format_maps_single_line {
111 0 0   0 1   my $region = shift or croak 'Region required';
112              
113 0           my @args = @{$region}{qw(address_start address_end read write execute shared offset device inode)};
  0            
114 0 0         $args[2] = $args[2] ? 'r' : '-';
115 0 0         $args[3] = $args[3] ? 'w' : '-';
116 0 0         $args[4] = $args[4] ? 'x' : '-';
117 0 0         $args[5] = $args[5] ? 's' : 'p';
118              
119 0           return sprintf("%-72s %s\n", sprintf("%x-%x %s%s%s%s %08x %s %d", @args), $region->{pathname});
120             }
121              
122              
123             1;
124              
125             __END__