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


line stmt bran cond sub pod time code
1             package File::Open::NoCache::ReadOnly;
2              
3             # Author Nigel Horne: njh@bandsman.co.uk
4             # Copyright (C) 2019 Nigel Horne
5              
6             # Usage is subject to licence terms.
7             # The licence terms of this software are as follows:
8             # Personal single user, single computer use: GPL2
9             # All other users (including Commercial, Charity, Educational, Government)
10             # must apply in writing for a licence for use from Nigel Horne at the
11             # above e-mail.
12              
13 2     2   415190 use strict;
  2         7  
  2         56  
14 2     2   16 use warnings;
  2         3  
  2         58  
15 2     2   10 use Carp;
  2         4  
  2         106  
16 2     2   1439 use IO::AIO;
  2         11507  
  2         1085  
17              
18             =head1 NAME
19              
20             File::Open::NoCache::ReadOnly - Open a file and clear the cache afterward
21              
22             =head1 VERSION
23              
24             Version 0.02
25              
26             =cut
27              
28             our $VERSION = '0.02';
29              
30             =head1 SUBROUTINES/METHODS
31              
32             =head2 new
33              
34             Open a file that will be read once sequentially and not again,
35             optimising the cache accordingly.
36             One use case is building a large database from smaller files that are
37             only read in once,
38             Once the file has been used it's a waste of RAM to keep it in cache.
39              
40             use File::Open::NoCache::ReadOnly;
41             my $fh = File::Open::NoCache::ReadOnly->new('/etc/passwd');
42             my $fh2 = File::Open::NoCache::ReadOnly->new(filename => '/etc/group', fatal => 1);
43              
44             =cut
45              
46             sub new {
47 4     4 1 1093 my $proto = shift;
48 4   33     16 my $class = ref($proto) || $proto;
49              
50 4 50       10 return unless(defined($class));
51              
52 4         5 my %params;
53 4 50 66     24 if(ref($_[0]) eq 'HASH') {
    100          
    100          
54 0         0 %params = %{$_[0]};
  0         0  
55             } elsif(ref($_[0]) || !defined($_[0])) {
56 1         12 Carp::carp('Usage: ', __PACKAGE__, '->new(%args)');
57             } elsif(scalar(@_) % 2 == 0) {
58 2         6 %params = @_;
59             } else {
60 1         3 $params{'filename'} = shift;
61             }
62              
63 4 100       191 if(my $filename = $params{'filename'}) {
64 3 100       136 if(open(my $fd, '<', $filename)) {
65 2         12 IO::AIO::fadvise($fd, 0, 0, IO::AIO::FADV_SEQUENTIAL|IO::AIO::FADV_NOREUSE|IO::AIO::FADV_DONTNEED);
66 2         20 return bless { fd => $fd }, $class
67             }
68 1 50       7 if($params{'fatal'}) {
69 0         0 Carp::croak("$filename: $!");
70             }
71 1         28 Carp::carp("$filename: $!");
72 1         237 return;
73             }
74 1         13 Carp::carp('Usage: ', __PACKAGE__, '->new(filename => $filename)');
75 1         165 return;
76             }
77              
78             =head2 fd
79              
80             Returns the file descriptor of the file
81              
82             my $fd = $fh->fd();
83             my $line = <$fd>;
84              
85             =cut
86              
87             sub fd {
88 1     1 1 390 my $self = shift;
89              
90 1         3 return $self->{'fd'};
91             }
92              
93             =head2 close
94              
95             Shouldn't be needed as close happens automatically when there variable goes out of scope.
96             However Perl isn't as good at reaping as it'd have you believe, so this is here to force it when you
97             know you're finished with the object.
98              
99             =cut
100              
101             sub close {
102 3     3 1 540 my $self = shift;
103              
104 3 100       9 if(my $fd = $self->{'fd'}) {
105             # my @statb = stat($fd);
106             # IO::AIO::fadvise($fd, 0, $statb[7] - 1, IO::AIO::FADV_DONTNEED);
107 2         7 IO::AIO::fadvise($fd, 0, 0, IO::AIO::FADV_DONTNEED);
108              
109 2         28 close $fd;
110              
111 2         119 delete $self->{'fd'};
112             # } else {
113             # Seems to get false positives
114             # Carp::carp('Attempt to close object twice');
115             }
116             }
117              
118             sub DESTROY {
119 2 50 33 2   837 if(defined($^V) && ($^V ge 'v5.14.0')) {
120 2 50       11 return if ${^GLOBAL_PHASE} eq 'DESTRUCT'; # >= 5.14.0 only
121             }
122 2         5 my $self = shift;
123              
124 2 100       10 if(defined($self->{'fd'})) {
125 1         3 $self->close();
126             }
127             }
128              
129             =head1 AUTHOR
130              
131             Nigel Horne, C<< >>
132              
133             =head1 BUGS
134              
135             Please report any bugs or feature requests to
136             C,
137             or through the web interface at
138             L.
139             I will be notified, and then you'll
140             automatically be notified of progress on your bug as I make changes.
141              
142             =head1 SUPPORT
143              
144             You can find documentation for this module with the perldoc command.
145              
146             perldoc File::Open::NoCache::ReadOnly
147              
148             You can also look for information at:
149              
150             =over 4
151              
152             =item * RT: CPAN's request tracker
153              
154             L
155              
156             =item * CPAN Ratings
157              
158             L
159              
160             =item * Search CPAN
161              
162             L
163              
164             =back
165              
166             =head1 LICENSE AND COPYRIGHT
167              
168             Copyright 2019 Nigel Horne.
169              
170             Usage is subject to licence terms.
171              
172             The licence terms of this software are as follows:
173              
174             * Personal single user, single computer use: GPL2
175             * All other users (including Commercial, Charity, Educational, Government)
176             must apply in writing for a licence for use from Nigel Horne at the
177             above e-mail.
178              
179             =cut
180              
181             1;