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