package Linux::Info::MemStats;
use strict;
use warnings;
use Carp qw(croak);

our $VERSION = '2.17'; # VERSION

# ABSTRACT:  Collect linux memory information.


sub new {
    my $class = shift;
    my $opts  = ref( $_[0] ) ? shift : {@_};

    my %self = (
        files => {
            path    => '/proc',
            meminfo => 'meminfo',
        }
    );

    foreach my $file ( keys %{ $opts->{files} } ) {
        $self{files}{$file} = $opts->{files}->{$file};
    }

    $self{regex}          = qr/([\w\(\)]+):\s+(\d+)/;
    $self{inactive_regex} = qr/^inact_/;

    return bless \%self, $class;
}


sub get {
    my $self    = shift;
    my $class   = ref($self);
    my $file    = $self->{files};
    my %meminfo = ();

    my $filename =
      $file->{path} ? "$file->{path}/$file->{meminfo}" : $file->{meminfo};
    open my $fh, '<', $filename
      or croak "$class: unable to open $filename ($!)";

    while ( my $line = <$fh> ) {
        if (
            $line =~
/^((?:Mem|Swap)(?:Total|Free)|Buffers|Cached|SwapCached|Active|Inactive|
                        Dirty|Writeback|Mapped|Slab|Commit(?:Limit|ted_AS)):\s*(\d+)/x
          )
        {
            my ( $n, $v ) = ( $1, $2 );
            $n =~ tr/A-Z/a-z/;
            $meminfo{$n} = $v;
        }
        elsif ( $line =~ /^Inact_(?:dirty|laundry|clean):\s*(\d+)/ ) {
            $meminfo{inactive} += $1;
        }
    }

    close($fh);

    $meminfo{memused} = sprintf( '%u', $meminfo{memtotal} - $meminfo{memfree} );
    $meminfo{memusedper} =
      sprintf( '%.2f', 100 * $meminfo{memused} / $meminfo{memtotal} );
    $meminfo{swapused} =
      sprintf( '%u', $meminfo{swaptotal} - $meminfo{swapfree} );
    $meminfo{realfree} =
      sprintf( '%u', $meminfo{memfree} + $meminfo{buffers} + $meminfo{cached} );
    $meminfo{realfreeper} =
      sprintf( '%.2f', 100 * $meminfo{realfree} / $meminfo{memtotal} );

    # maybe there is no swap space on the machine
    if ( !$meminfo{swaptotal} ) {
        $meminfo{swapusedper} = '0.00';
    }
    else {
        $meminfo{swapusedper} =
          sprintf( '%.2f', 100 * $meminfo{swapused} / $meminfo{swaptotal} );
    }

    return \%meminfo;
}


sub get_more {
    my $self    = shift;
    my $class   = ref($self);
    my $file    = $self->{files};
    my %meminfo = ();

    my $filename =
      $file->{path} ? "$file->{path}/$file->{meminfo}" : $file->{meminfo};
    open my $fh, '<', $filename
      or croak "$class: unable to open $filename ($!)";

    while ( my $line = <$fh> ) {
        if ( $line =~ $self->{regex} ) {
            my ( $n, $v ) = ( $1, $2 );
            $n =~ tr/A-Z/a-z/;
            $meminfo{$n} = $v;
        }

        if ( $line =~ $self->{inactive_regex} ) {
            $meminfo{inactive} += $1;
        }
    }

    close($fh);

    $meminfo{memused} = sprintf( '%u', $meminfo{memtotal} - $meminfo{memfree} );
    $meminfo{memusedper} =
      sprintf( '%.2f', 100 * $meminfo{memused} / $meminfo{memtotal} );
    $meminfo{swapused} =
      sprintf( '%u', $meminfo{swaptotal} - $meminfo{swapfree} );
    $meminfo{realfree} =
      sprintf( '%u', $meminfo{memfree} + $meminfo{buffers} + $meminfo{cached} );
    $meminfo{realfreeper} =
      sprintf( '%.2f', 100 * $meminfo{realfree} / $meminfo{memtotal} );

    # maybe there is no swap space on the machine
    if ( !$meminfo{swaptotal} ) {
        $meminfo{swapusedper} = '0.00';
    }
    else {
        $meminfo{swapusedper} =
          sprintf( '%.2f', 100 * $meminfo{swapused} / $meminfo{swaptotal} );
    }

    return \%meminfo;
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Linux::Info::MemStats - Collect linux memory information.

=head1 VERSION

version 2.17

=head1 SYNOPSIS

    use Linux::Info::MemStats;

    my $lxs  = Linux::Info::MemStats->new;
    my $stat = $lxs->get;

=head1 DESCRIPTION

Linux::Info::MemStats gathers memory statistics from the virtual F</proc>
filesystem (procfs).

For more information read the documentation of the front-end module
L<Linux::Info>.

=head1 MEMORY INFORMATIONS

Generated by F</proc/meminfo>.

Check out the SEE ALSO section for details on what is extracted and what it
means. The list is extensive and Linux kernel is always being updated to keep
track of it here.

=head1 METHODS

=head2 new()

Call C<new()> to create a new object.

    my $lxs = Linux::Info::MemStats->new;

It's possible to set the path to the proc filesystem.

     Linux::Info::MemStats->new(
        files => {
            # This is the default
            path    => '/proc',
            meminfo => 'meminfo',
        }
    );

=head2 get()

C<get()> returns the statistics as a hash reference.

    my $stats_ref = $lxs->get;

This is the original method as defined in L<Sys::Statistics::Linux>
distribution and was kept here for backward compatibility since the amount of
information returned is somehow limited, for example, there is no Hugepages
information included. Of course, you might not need it anyway, but as time goes
by the Linux kernel might include more information (and remove some) and it's
hard to keep track of it.

Short long story: if this method returns the information you need it, use it,
since the other method C<get_more> will be slower.

Here is the list of information returned explained:

memused         -  Total size of used memory in kilobytes.
memfree         -  Total size of free memory in kilobytes.
memusedper      -  Total size of used memory in percent.
memtotal        -  Total size of memory in kilobytes.
buffers         -  Total size of buffers used from memory in kilobytes.
cached          -  Total size of cached memory in kilobytes.
realfree        -  Total size of memory is real free (memfree + buffers + cached).
realfreeper     -  Total size of memory is real free in percent of total memory.
swapused        -  Total size of swap space is used is kilobytes.
swapfree        -  Total size of swap space is free in kilobytes.
swapusedper     -  Total size of swap space is used in percent.
swaptotal       -  Total size of swap space in kilobytes.
swapcached      -  Memory that once was swapped out, is swapped back in but still also is in the swapfile.
active          -  Memory that has been used more recently and usually not reclaimed unless absolutely necessary.
inactive        -  Memory which has been less recently used and is more eligible to be reclaimed for other purposes.
                   On earlier kernels (2.4) Inact_dirty + Inact_laundry + Inact_clean.

The following statistics are only available by kernels from 2.6.

slab            -  Total size of memory in kilobytes that used by kernel for data structure allocations.
dirty           -  Total size of memory pages in kilobytes that waits to be written back to disk.
mapped          -  Total size of memory in kilbytes that is mapped by devices or libraries with mmap.
writeback       -  Total size of memory that was written back to disk.
committed_as    -  The amount of memory presently allocated on the system.

The following statistic is only available by kernels from 2.6.9.

commitlimit     -  Total amount of memory currently available to be allocated on the system.

=head2 get_more

It does the same thing as C<get>, but returns all data read from
F</proc/meminfo>.

It also includes C<inactive> for the same purposes, but due the amount of data
read, is a bit slower than C<get>.

=head1 EXPORTS

Nothing.

=head1 SEE ALSO

=over

=item *

B<proc(5)>

=item *

L<https://www.kernel.org/doc/Documentation/filesystems/proc.txt>, C<meminfo>
section.

=item *

L<https://www.kernel.org/doc/Documentation/vm/hugetlbpage.txt>.

=item *

L<Linux::Info>

=back

=head1 AUTHOR

Alceu Rodrigues de Freitas Junior <glasswalk3r@yahoo.com.br>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2015 by Alceu Rodrigues de Freitas Junior.

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=cut
