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