view release on metacpan or  search on metacpan

lib/File/Locate/Iterator/FileMap.pm  view on Meta::CPAN

use Carp;

# uncomment this to run the ### lines
#use Devel::Comments;

our $VERSION = 28;

our %cache;

sub _key {
  my ($fh) = @_;
  my ($dev, $ino, undef, undef, undef, undef, undef, $size) = stat ($fh);
  return "$dev,$ino,$size,".tell($fh);
}
sub find {
  my ($class, $fh) = @_;
  return $cache{_key($fh)};
}

# return a FileMap object which is $fh mmapped
sub get {
  my ($class, $fh) = @_;

  my $key = _key($fh);
  ### cache get: "$fh, $key, size=".(-s $fh)
  return ($cache{$key} || do {
    require File::Map;
    # File::Map->VERSION('0.35'); # for binary handled properly, maybe
    File::Map->VERSION('0.38'); # for tainting
    require PerlIO::Layers;
    require Scalar::Util;

    PerlIO::Layers::query_handle ($fh, 'mappable')
        or croak "Handle not mappable";

    my $self = bless { key  => $key,
                       mmap => undef,
                     }, $class;

    my $tell = tell($fh);
    if ($tell < 0) {
      # assume if tell() doesn't work then $fh is not mmappable, or in any
      # case don't know where the current position is to map
      croak "Cannot tell() file position: $!";
    }

    # File::Map 0.38 does tainting itself
    #
    # # induce taint on the mmap -- seems to cause segvs though
    # read $fh, $self->{'mmap'}, 0;
    # use Devel::Peek;
    # Dump ($self->{'mmap'});
    #
    # # crib: must taint before mapping, doesn't work afterwards
    # require Taint::Util;
    # Taint::Util::taint($self->{'mmap'});

    File::Map::map_handle ($self->{'mmap'}, $fh, '<', $tell);
    File::Map::advise ($self->{'mmap'}, 'sequential');

    Scalar::Util::weaken ($cache{$key} = $self);
    $self;
  });
}
# return a scalar ref to the mmapped string
sub mmap_ref {
  my ($self) = @_;
  return \($self->{'mmap'});
}
sub DESTROY {
  my ($self) = @_;
  delete $cache{$self->{'key'}};
}

use constant::defer _PAGESIZE => sub {
  require POSIX;
  my $pagesize = eval { POSIX::sysconf (POSIX::_SC_PAGESIZE()) } || -1;
  return ($pagesize > 0 ? $pagesize : 1024);
};

# return the total bytes used by mmaps here plus prospective further $space
sub _total_space {
  my ($space) = @_;
  ### total space of: $space, values(%cache)
  $space = _round_up_pagesize($space);
  foreach my $self (values %cache) {
    $space += _round_up_pagesize (length (${$self->mmap_ref}));
  }
  return $space;
}
sub _round_up_pagesize {
  my ($n) = @_;

  my $pagesize = _PAGESIZE();
  return $pagesize * int (($n + $pagesize - 1) / $pagesize);
}

#-----------------------------------------------------------------------------

# return true if $fh has an ":mmap" layer
sub _have_mmap_layer {
  my ($fh) = @_;
  my $ret;
  eval {
    require PerlIO; # new in perl 5.8
    foreach my $layer (PerlIO::get_layers ($fh)) {
      if ($layer eq 'mmap') { $ret = 1; last; }
    }
  };
  return $ret;
}

# return true if mmapping $fh would be an excessive cumulative size
sub _mmap_size_excessive {
  my ($fh) = @_;
  if (File::Locate::Iterator::FileMap->find($fh)) {
    # if already mapped then not excessive
    return 0;
  }

  # in 32-bits this is 4G*(1/4)*(1/5) which is 200Mb