File Coverage

blib/lib/Linux/Info/DiskUsage.pm
Criterion Covered Total %
statement 59 68 86.7
branch 10 18 55.5
condition 11 15 73.3
subroutine 11 11 100.0
pod 3 3 100.0
total 94 115 81.7


line stmt bran cond sub pod time code
1             package Linux::Info::DiskUsage;
2 2     2   693 use strict;
  2         6  
  2         59  
3 2     2   10 use warnings;
  2         4  
  2         55  
4 2     2   10 use Carp qw(croak);
  2         4  
  2         111  
5 2     2   888 use Set::Tiny 0.01;
  2         2656  
  2         110  
6 2     2   901 use Filesys::Df 0.92;
  2         2313  
  2         111  
7 2     2   1035 use Hash::Util 'lock_keys';
  2         5515  
  2         16  
8              
9             our $VERSION = '1.4'; # VERSION
10              
11             =head1 NAME
12              
13             Linux::Info::DiskUsage - Collect linux disk usage.
14              
15             =head1 SYNOPSIS
16              
17             use Linux::Info::DiskUsage;
18              
19             my $lxs = Linux::Info::DiskUsage->new;
20             my $stat = $lxs->get;
21              
22             =head1 DESCRIPTION
23              
24             Linux::Info::DiskUsage gathers the disk usage. Previous versions of this module used the C command to retrieve
25             such information. Since release 0.08, C was deprecated to avoid doing additional syscalls and potencially dangerous
26             environment variables manipulations. See B section for references about the new implementation.
27              
28             General output should be the same as generated by C, but output is filtered based on "valid" file systems that are
29             mounted (to avoid what C defines as "dummy" file systems). See the C and C methods for more details.
30              
31             For more information read the documentation of the front-end module L.
32              
33             =head1 DISK USAGE INFORMATIONS
34              
35             =over
36              
37             =item *
38              
39             total - The total size of the disk.
40              
41             =item *
42              
43             usage - The used disk space in kilobytes.
44              
45             =item *
46              
47             free - The free disk space in kilobytes.
48              
49             =item *
50              
51             usageper - The used disk space in percent.
52              
53             =item *
54              
55             mountpoint - The moint point of the disk.
56              
57             =back
58              
59             In the event that the mount point doesn't have some or all this information (for example, AUFS mount points used by Docker), the values will
60             be automatically assigned as "-" (without quotes).
61              
62             Optionally this class might also include inodes information as defined in L. Check the C method description for more details.
63              
64             =head1 METHODS
65              
66             =head2 new()
67              
68             Call C to create a new object.
69              
70             my $lxs = Linux::Info::DiskUsage->new;
71              
72             Optionally it accepts two positional parameters as well.
73              
74             It's possible to pass additional file system names (as available on C) so
75             you can see more mounted file systems in the returned value of C method. The expected
76             parameter for that must be an array reference, as shown below:
77              
78             Linux::Info::DiskUsage->new([qw(reiserfs xfs)]);
79              
80             Additional values given like that will be B to the default set of accepted values.
81              
82             This class also accepts a second parameter that defines if the instance will also provide inode information
83             from the file systems as well. This extends and breaks compatibility with L
84             interface. To enable that, just pass one to enabled it, for example:
85              
86             Linux::Info::DiskUsage->new([qw(reiserfs xfs)], 1);
87              
88             The interface of L also remains the same, so you can't use these extended options from it. This might change
89             in future implementations, but for now you need to create an instance from Linux::Info::DiskUsage directly from C.
90              
91             =cut
92              
93             sub new {
94 2     2 1 1068 my ( $class, $opts_ref, $has_inode ) = @_;
95 2         10 my $valids_ref = Linux::Info::DiskUsage->default_fs;
96              
97 2 50       9 if ( defined($opts_ref) ) {
98 0 0       0 croak 'Additional file system names must be given as an array reference'
99             unless ( ref($opts_ref) eq 'ARRAY' );
100              
101 0         0 foreach my $type ( @{$opts_ref} ) {
  0         0  
102 0         0 push( @{$valids_ref}, $type );
  0         0  
103             }
104              
105             }
106             my %self = (
107 2   100     5 fstypes => Set::Tiny->new( @{$valids_ref} ),
  2         12  
108             has_inode => $has_inode || 0
109             );
110 2         36 my $self = bless \%self, $class;
111 2         5 return lock_keys( %{$self} );
  2         14  
112             }
113              
114             =head2 get()
115              
116             Call C to get the statistics. C returns the statistics as a hash reference.
117              
118             my $stat = $lxs->get;
119              
120             The hash reference will have keys and values as described in B section.
121              
122             =cut
123              
124             sub get {
125 2     2 1 22 my $self = shift;
126 2         11 my $mount_entries = $self->_read;
127 2         8 my %disk_usage;
128              
129 2         3 foreach my $entry ( @{$mount_entries} ) {
  2         8  
130 32         86 my $ref = df( $entry->[1] );
131             my %info = (
132             total => $ref->{user_blocks} || '-',
133             usage => $ref->{used} || '-',
134             mountpoint => $entry->[1] || '-',
135             free => $ref->{bfree} || '-',
136 32   100     3159 usageper => $ref->{per} || '-'
      100        
      50        
      50        
      100        
137             );
138              
139 32 100       73 if ( $self->{has_inode} ) {
140 16         34 my @inode_keys = (qw(files ffree favail fused fper));
141 16 50       28 if ( exists( $ref->{files} ) ) {
142 16         26 foreach my $key (@inode_keys) {
143 80         148 $info{$key} = $ref->{$key};
144             }
145             }
146             else {
147 0         0 foreach my $key (@inode_keys) {
148 0         0 $info{$key} = '-';
149             }
150             }
151             }
152              
153 32         128 $disk_usage{ $entry->[0] } = \%info;
154             }
155 2         13 return \%disk_usage;
156             }
157              
158             =head2 default_fs
159              
160             Returns and array reference with the file systems that are mounted and will have
161             their storage space checked by default.
162              
163             This method can be invoke both directly from the class and from instances of it.
164              
165             =cut
166              
167             sub default_fs {
168 2     2 1 7 return [qw(devtmpfs tmpfs ext2 ext3 ext4 fuseblk xfs)];
169             }
170              
171             sub _is_valid {
172 74     74   129 my ( $self, $fs_type ) = @_;
173 74 50       128 croak 'file system type must be defined' unless ( defined($fs_type) );
174 74         162 return $self->{fstypes}->has($fs_type);
175             }
176              
177             # strongly based on Linux::Proc::Mounts module, but much more restricted
178             # in terms of information accepted and provided
179             sub _read {
180 2     2   5 my $self = shift;
181 2         7 my $mnt = "/proc";
182 2 50 33     70 croak "$mnt is not a proc filesystem"
183             unless -d $mnt and ( stat _ )[12] == 0;
184 2         11 my $file = "$mnt/mounts";
185 2 50       166 open my $fh, '<', $file
186             or croak "Unable to open '$file': $!";
187 2         9 my @entries;
188              
189 2         335 while ( local $_ = <$fh> ) {
190 74         744 chomp;
191 74         238 my @entry = split;
192              
193 74 50       148 if ( @entry != 6 ) {
194 0         0 warn "invalid number of entries in $file line $.";
195 0         0 next;
196             }
197              
198 74         168 $#entry = 3; # ignore the two dummy values at the end
199 74         234 s/\\([0-7]{1,3})/chr oct $1/g for @entry;
200              
201             # fs_spec and fs_file are returned as an entry
202 74 100       137 push( @entries, [ $entry[0], $entry[1] ] )
203             if $self->_is_valid( $entry[2] );
204             }
205              
206 2         63 close($file);
207 2         34 return \@entries;
208             }
209              
210             =head1 EXPORTS
211              
212             Nothing.
213              
214             =head1 SEE ALSO
215              
216             =over
217              
218             =item *
219              
220             B
221              
222             =item *
223              
224             L
225              
226             =item *
227              
228             L: this class borrows code from it.
229              
230             =item *
231              
232             L
233              
234             =back
235              
236             =head1 AUTHOR
237              
238             Alceu Rodrigues de Freitas Junior, Earfreitas@cpan.orgE
239              
240             =head1 COPYRIGHT AND LICENSE
241              
242             This software is copyright (c) 2015 of Alceu Rodrigues de Freitas Junior, Earfreitas@cpan.orgE
243              
244             This file is part of Linux Info project.
245              
246             Linux-Info is free software: you can redistribute it and/or modify
247             it under the terms of the GNU General Public License as published by
248             the Free Software Foundation, either version 3 of the License, or
249             (at your option) any later version.
250              
251             Linux-Info is distributed in the hope that it will be useful,
252             but WITHOUT ANY WARRANTY; without even the implied warranty of
253             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
254             GNU General Public License for more details.
255              
256             You should have received a copy of the GNU General Public License
257             along with Linux Info. If not, see .
258              
259             =cut
260              
261             1;