File: linux.proc.meminfo.code

package info (click to toggle)
librpc-xml-perl 0.76-3
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,320 kB
  • sloc: perl: 9,222; xml: 2,634; makefile: 12
file content (48 lines) | stat: -rw-r--r-- 1,210 bytes parent folder | download | duplicates (9)
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
###############################################################################
#
#   Sub Name:       linux_proc_meminfo
#
#   Description:    Read the /proc/meminfo on a Linux server and return a
#                   STRUCT with the information.
#
#   Arguments:      None.
#
#   Returns:        hashref
#
###############################################################################
sub linux_proc_meminfo
{
    use strict;

    my (%meminfo, $line, $key, @parts);
    local *F;

    open(F, '/proc/meminfo') or
        return RPC::XML::fault->new(501, "Cannot open /proc/meminfo: $!");

    while (defined($line = <F>))
    {
        next if ($line =~ /^\s+/);
        chomp $line;

        @parts = split(/\s+/, $line);
        $key = shift(@parts);
        if ($key eq 'Mem:')
        {
            @meminfo{qw(mem_total mem_used mem_free mem_shared mem_buffers
                        mem_cached)} = @parts;
        }
        elsif ($key eq 'Swap:')
        {
            @meminfo{qw(swap_total swap_used swap_free)} = @parts;
        }
        else
        {
            chop $key; # Lose the trailing ':'
            $meminfo{$key} = join(' ', @parts);
        }
    }
    close(F);

    \%meminfo;
}