The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

BLOONIX / Sys-Statistics-Linux-0.55_02 / lib / Sys / Statistics / Linux / DiskUsage.pm 

            

              
—
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

              
=head1 NAME
Sys::Statistics::Linux::DiskUsage - Collect linux disk usage.
=head1 SYNOPSIS
    use Sys::Statistics::Linux::DiskUsage;
    my $lxs  = new Sys::Statistics::Linux::DiskUsage;
    my $stat = $lxs->get;
=head1 DESCRIPTION
Sys::Statistics::Linux::DiskUsage gathers the disk usage with the command C<df>.
For more informations read the documentation of the front-end module L<Sys::Statistics::Linux>.
=head1 DISK USAGE INFORMATIONS
Generated by F</bin/df -kP>.
    total       -  The total size of the disk.
    usage       -  The used disk space in kilobytes.
    free        -  The free disk space in kilobytes.
    usageper    -  The used disk space in percent.
    mountpoint  -  The moint point of the disk.
=head2 GLOBAL VARS
If you want to change the path or arguments for C<df> you can use the following
variables...
    $Sys::Statistics::Linux::DiskUsage::DF_PATH = '/bin';
    $Sys::Statistics::Linux::DiskUsage::DF_CMD  = 'df -akP';
Example:
    use Sys::Statistics::Linux;
    use Sys::Statistics::Linux::DiskUsage;
    $Sys::Statistics::Linux::DiskUsage::DF_CMD = 'df -akP';
    my $sys  = Sys::Statistics::Linux->new(diskusage => 1);
    my $disk = $sys->get;
=head1 METHODS
=head2 new()
Call C<new()> to create a new object.
    my $lxs = Sys::Statistics::Linux::DiskUsage->new;
=head2 get()
Call C<get()> to get the statistics. C<get()> returns the statistics as a hash reference.
    my $stat = $lxs->get;
=head1 EXPORTS
No exports.
=head1 SEE ALSO
B<df(1)>
=head1 REPORTING BUGS
Please report all bugs to <jschulz.cpan(at)bloonix.de>.
=head1 AUTHOR
Jonny Schulz <jschulz.cpan(at)bloonix.de>.
=head1 COPYRIGHT
Copyright (c) 2006, 2007 by Jonny Schulz. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
package Sys::Statistics::Linux::DiskUsage;
use strict;
use warnings;
use Carp qw(croak);
our $VERSION = '0.10';
our $DF_PATH = undef;
our $DF_CMD  = undef;
sub new {
    my $class = shift;
    my %self = (
        cmd => {
            path => '/bin',
            df   => 'df -kP',
        }
    );
    return bless \%self, $class;
}
sub get {
    my $self   = shift;
    my $class  = ref $self;
    my $cmd    = $self->{cmd};
    my $df_cmd = $DF_CMD || $cmd->{df};
    my (%disk_usage, $disk_name);
    local $ENV{PATH} = $DF_PATH || $cmd->{path};
    open my $fh, "$df_cmd|" or croak "$class: unable to execute '$df_cmd' ($!)";
    # filter the header
    {my $null = <$fh>;}
    while (my $line = <$fh>) {
        next unless $line =~ /^(.+?)\s+(.+)$/ && !$disk_name;
        @{$disk_usage{$1}}{qw(
            total
            usage
            free
            usageper
            mountpoint
        )} = (split /\s+/, $2)[0..4];
        $disk_usage{$1}{usageper} =~ s/%//;
    }
    close($fh);
    return \%disk_usage;
}
1;