The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Sys::PageCache;

use strict;
use warnings;
use 5.008001;
use Carp;
use base qw(Exporter);
our @EXPORT = qw(page_size fincore fadvise
                 POSIX_FADV_NORMAL
                 POSIX_FADV_SEQUENTIAL
                 POSIX_FADV_RANDOM
                 POSIX_FADV_NOREUSE
                 POSIX_FADV_WILLNEED
                 POSIX_FADV_DONTNEED
            );
our @EXPORT_OK = qw();

our $VERSION = '0.03';

use POSIX;

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

sub fincore {
    my($file, $offset, $length) = @_;

    if (! $offset) {
        $offset = 0;
    } elsif ($offset < 0) {
        croak "offset must be >= 0";
    } else {
        my $pa_offset = $offset & ~(page_size() - 1);
        if ($pa_offset != $offset) {
            carp(sprintf "[WARN] offset must be a multiple of the page size so change %llu to %llu",
                 $offset,
                 $pa_offset,
             );
            $offset = $pa_offset;
        }
    }

    my $fsize = (stat $file)[7];
    if (! $length) {
        $length = $fsize;
    } elsif ($length > $fsize - $offset) {
        my $new_length = $fsize - $offset;
        carp(sprintf "[WARN] fincore: length(%llu) is greater than file size(%llu) - offset(%llu). so use file size - offset (=%llu)",
             $length,
             $fsize,
             $offset,
             $new_length,
         );
        $length = $new_length;
    }

    open my $fh, '<', $file or croak $!;
    my $fd = fileno $fh;

    my($r, $e);
    {
        local $@;
        $r = eval {
            _fincore($fd, $offset, $length);
        };
        chomp($e = $@) if $@;
    }
    close $fh;

    if (defined $e) {
        carp $e;
        return;
    }

    $r->{file_size}   = $fsize;
    $r->{total_pages} = ceil($fsize / $r->{page_size});

    return $r;
}

sub fadvise {
    my($file, $offset, $length, $advice) = @_;

    croak "missing advice" unless defined $advice;
    croak "missing length" unless defined $length;
    croak "missing offset" unless defined $offset;
    croak "missing file"   unless defined $file;

    croak "offset must be >= 0" if $offset < 0;

    my $fsize = (stat $file)[7];
    if ($length > $fsize - $offset) {
        my $new_length = $fsize - $offset;
        carp(sprintf "[WARN] fadvise: length(%llu) is greater than file size(%llu) - offset(%llu). so use file size - offset (=%llu)",
             $length,
             $fsize,
             $offset,
             $new_length,
         );
        $length = $new_length;
    }

    open my $fh, '<', $file or croak $!;
    my $fd = fileno $fh;

    my($r, $e);
    {
        local $@;
        $r = eval {
            _fadvise($fd, $offset, $length, $advice);
        };
        chomp($e = $@) if $@;
    }
    close $fh;

    if (defined $e) {
        carp $e;
        return;
    }

    return $r == 0 ? 1 : ();
}

1;
__END__

=encoding utf-8

=begin html

<a href="https://travis-ci.org/hirose31/Sys-PageCache"><img src="https://travis-ci.org/hirose31/Sys-PageCache.png?branch=master" alt="Build Status" /></a>
<a href="https://coveralls.io/r/hirose31/Sys-PageCache?branch=master"><img src="https://coveralls.io/repos/hirose31/Sys-PageCache/badge.png?branch=master" alt="Coverage Status" /></a>

=end html

=head1 NAME

Sys::PageCache - handling page cache related on files

=begin readme

=head1 INSTALLATION

To install this module, run the following commands:

    perl Makefile.PL
    make
    make test
    make install

=end readme

=head1 SYNOPSIS

    use Sys::PageCache;
    
    # determine whether pages are resident in memory
    $r = fincore "/path/to/file";
    printf("cached/total_size=%llu/%llu cached/total_pages=%llu/%llu\n",
           $r->{cached_size}, $r->{file_size},
           $r->{cached_pages}, $r->{total_pages},
       );
    
    # free cached pages on a file
    $r = fadvise "/path/to/file", 0, 0, POSIX_FADV_DONTNEED;

=head1 DESCRIPTION

Sys::PageCache is for handling page cache related on files.

=head1 METHODS

=over 4

=item B<fincore>($filepath:Str [, $offset:Int [, $length:Int]])

Determine whether pages are resident in memory.
C<$offset> and C<$length> are optional.

C<fincore> returns a following hash ref.

    {
       cached_pages => Int, # number of cached pages
       cached_size  => Int, # size of cached pages
       total_pages  => Int, # number of pages if cached whole file
       file_size    => Int, # size of file
       page_size    => Int, # page size on your system
    }


=item B<fadvise>($filepath:Str, $offset:Int, $length:Int, $advice:Int)

Call posix_fadvise(2).

C<fadvise> returns 1 if success.

=item B<page_size>()

Returns size of page size on your system.

=back

=head1 EXPORTS

=over 4

=item fincore

=item fadvise

=item POSIX_FADV_NORMAL

=item POSIX_FADV_SEQUENTIAL

=item POSIX_FADV_RANDOM

=item POSIX_FADV_NOREUSE

=item POSIX_FADV_WILLNEED

=item POSIX_FADV_DONTNEED

=back

=head1 AUTHOR

HIROSE Masaaki E<lt>hirose31 _at_ gmail.comE<gt>

=head1 REPOSITORY

L<https://github.com/hirose31/Sys-PageCache>

  git clone git://github.com/hirose31/Sys-PageCache.git

patches and collaborators are welcome.

=head1 SEE ALSO

mincore(2), posix_fadvise(2),
L<https://code.google.com/p/linux-ftools/>,
L<https://github.com/nhayashi/pagecache-tool>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut