File Coverage

blib/lib/File/Open/NoCache/ReadOnly.pm

Criterion	Covered	Total	%
statement	41	44	93.1
branch	17	22	77.2
condition	4	9	44.4
subroutine	8	8	100.0
pod	3	3	100.0
total	73	86	84.8

package File::Open::NoCache::ReadOnly;

# Author Nigel Horne: [e-mail]
# Copyright (C) 2019 Nigel Horne

# Usage is subject to licence terms.
# The licence terms of this software are as follows:
# Personal single user, single computer use: GPL2
# All other users (including Commercial, Charity, Educational, Government)
#	must apply in writing for a licence for use from Nigel Horne at the
#	above e-mail.

use strict;
use warnings;
use Carp;
use IO::AIO;

=head1 NAME

File::Open::NoCache::ReadOnly - Open a file and clear the cache afterward

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

=head1 SUBROUTINES/METHODS

=head2 new

Open a file that will be read once sequentially and not again,
optimising the cache accordingly.
One use case is building a large database from smaller files that are
only read in once,
Once the file has been used it's a waste of RAM to keep it in cache.

    use File::Open::NoCache::ReadOnly;
    my $fh = File::Open::NoCache::ReadOnly->new('/etc/passwd');
    my $fh2 = File::Open::NoCache::ReadOnly->new(filename => '/etc/group', fatal => 1);

=cut

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	return unless(defined($class));

	my %params;
	if(ref($_[0]) eq 'HASH') {
		%params = %{$_[0]};
	} elsif(ref($_[0]) || !defined($_[0])) {
		Carp::carp('Usage: ', __PACKAGE__, '->new(%args)');
	} elsif(scalar(@_) % 2 == 0) {
		%params = @_;
	} else {
		$params{'filename'} = shift;
	}

	if(my $filename = $params{'filename'}) {
		if(open(my $fd, '<', $filename)) {
			IO::AIO::fadvise($fd, 0, 0, IO::AIO::FADV_SEQUENTIAL|IO::AIO::FADV_NOREUSE|IO::AIO::FADV_DONTNEED);
			return bless { fd => $fd }, $class
		}
		if($params{'fatal'}) {
			Carp::croak("$filename: $!");
		}
		Carp::carp("$filename: $!");
		return;
	}
	Carp::carp('Usage: ', __PACKAGE__, '->new(filename => $filename)');
	return;
}

=head2	fd

Returns the file descriptor of the file

    my $fd = $fh->fd();
    my $line = <$fd>;

=cut

sub fd {
	my $self = shift;

	return $self->{'fd'};
}

=head2	close

Shouldn't be needed as close happens automatically when there variable goes out of scope.
However Perl isn't as good at reaping as it'd have you believe, so this is here to force it when you
know you're finished with the object.

=cut

sub close {
	my $self = shift;

	if(my $fd = $self->{'fd'}) {
		# my @statb = stat($fd);
		# IO::AIO::fadvise($fd, 0, $statb[7] - 1, IO::AIO::FADV_DONTNEED);
		IO::AIO::fadvise($fd, 0, 0, IO::AIO::FADV_DONTNEED);

		close $fd;

		delete $self->{'fd'};
	# } else {
		# Seems to get false positives
		# Carp::carp('Attempt to close object twice');
	}
}

sub DESTROY {
	if(defined($^V) && ($^V ge 'v5.14.0')) {
		return if ${^GLOBAL_PHASE} eq 'DESTRUCT';	# >= 5.14.0 only
	}
	my $self = shift;

	if(defined($self->{'fd'})) {
		$self->close();
	}
}

=head1 AUTHOR

Nigel Horne, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C,
or through the web interface at
L.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc File::Open::NoCache::ReadOnly

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2019 Nigel Horne.

Usage is subject to licence terms.

The licence terms of this software are as follows:

* Personal single user, single computer use: GPL2
* All other users (including Commercial, Charity, Educational, Government)
  must apply in writing for a licence for use from Nigel Horne at the
  above e-mail.

=cut

1;