File Coverage

blib/lib/Sys/PageCache.pm

Criterion	Covered	Total	%
statement	67	76	88.1
branch	24	38	63.1
condition			n/a
subroutine	8	8	100.0
pod	2	2	100.0
total	101	124	81.4

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.06';

our $MAX_CHUNK_SIZE = 512*1024*1024;

use POSIX qw(ceil);

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($ret, $r, $e);
    for (; $offset < $fsize; $offset += $MAX_CHUNK_SIZE, $length -= $MAX_CHUNK_SIZE) {
        my $chunk_size = $length < $MAX_CHUNK_SIZE ? $length : $MAX_CHUNK_SIZE;
        # warn "offset=$offset length=$length chunk_size=$chunk_size\n";
        local $@;
        $r = eval {
            _fincore($fd, $offset, $chunk_size);
        };
        if ($@) {
            chomp($e = $@);
            carp $e;
            close $fh;
            return;
        } else {
            for my $k (keys %$r) {
                next if $k eq 'page_size';
                $ret->{$k} += $r->{$k};
            }
        }
    }
    close $fh;

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

    return $ret;
}

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__