File Coverage

blib/lib/File/Open/ReadOnly/NoCache.pm
Criterion Covered Total %
statement 33 38 86.8
branch 11 18 61.1
condition 3 9 33.3
subroutine 7 7 100.0
pod 2 2 100.0
total 56 74 75.6


line stmt bran cond sub pod time code
1             package File::Open::ReadOnly::NoCache;
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   372334 use strict;
  2         7  
  2         48  
14 2     2   10 use warnings;
  2         4  
  2         40  
15 2     2   10 use Carp;
  2         2  
  2         106  
16 2     2   1297 use IO::AIO;
  2         10353  
  2         867  
17              
18             =head1 NAME
19              
20             File::Open::ReadOnly::NoCache - Open a file and clear the cache afterward
21              
22             =head1 VERSION
23              
24             Version 0.01
25              
26             =cut
27              
28             our $VERSION = '0.01';
29              
30             =head1 SUBROUTINES/METHODS
31              
32             =head2 new
33              
34             Open a file and flush the cache afterwards.
35             One use case is building a large database from smaller files that are
36             only read in once.
37             Once the file has been used it's a waste of RAM to keep it in cache.
38              
39             use File::Open::ReadOnly::NoCache;
40             my $fh = File::Open::ReadOnly::NoCache->new('/etc/passwd');
41              
42             =cut
43              
44             sub new {
45 2     2 1 449 my $proto = shift;
46 2   33     10 my $class = ref($proto) || $proto;
47              
48 2 50       7 return unless(defined($class));
49              
50 2         3 my %params;
51 2 50 33     15 if(ref($_[0]) eq 'HASH') {
    50          
    100          
52 0         0 %params = %{$_[0]};
  0         0  
53             } elsif(ref($_[0]) || !defined($_[0])) {
54 0         0 Carp::croak('Usage: ', __PACKAGE__, '->new(%args)');
55             } elsif(scalar(@_) % 2 == 0) {
56 1         4 %params = @_;
57             } else {
58 1         3 $params{'filename'} = shift;
59             }
60              
61 2 50       5 if(my $filename = $params{'filename'}) {
62 2 100       88 if(open(my $fd, '<', $filename)) {
63 1         10 return bless { fd => $fd }, $class
64             }
65 1         28 Carp::carp("$filename: $!");
66 1         240 return;
67             }
68 0         0 Carp::carp('Usage: ', __PACKAGE__, '->new(filename => $filename)');
69 0         0 return;
70             }
71              
72             =head2 fd
73              
74             Returns the file descriptor of the file
75              
76             my $fd = $fh->fd();
77             my $line = <$fd>;
78              
79             =cut
80              
81             sub fd {
82 1     1 1 521 my $self = shift;
83              
84 1         5 return $self->{'fd'};
85             }
86              
87             sub DESTROY {
88 1 50 33 1   279 if(defined($^V) && ($^V ge 'v5.14.0')) {
89 1 50       5 return if ${^GLOBAL_PHASE} eq 'DESTRUCT'; # >= 5.14.0 only
90             }
91 1         3 my $self = shift;
92              
93 1 50       4 if(my $fd = $self->{'fd'}) {
94             # my @statb = stat($fd);
95             # IO::AIO::fadvise($fd, 0, $statb[7] - 1, IO::AIO::FADV_DONTNEED);
96 1         22 IO::AIO::fadvise($fd, 0, 0, IO::AIO::FADV_DONTNEED);
97              
98 1         12 close $self->{'fd'};
99              
100 1         109 delete $self->{'fd'};
101             }
102             }
103              
104             =head1 AUTHOR
105              
106             Nigel Horne, C<< >>
107              
108             =head1 BUGS
109              
110             Please report any bugs or feature requests to
111             C,
112             or through the web interface at
113             L.
114             I will be notified, and then you'll
115             automatically be notified of progress on your bug as I make changes.
116              
117             =head1 SUPPORT
118              
119             You can find documentation for this module with the perldoc command.
120              
121             perldoc File::Open::ReadOnly::NoCache
122              
123             You can also look for information at:
124              
125             =over 4
126              
127             =item * RT: CPAN's request tracker
128              
129             L
130              
131             =item * AnnoCPAN: Annotated CPAN documentation
132              
133             L
134              
135             =item * CPAN Ratings
136              
137             L
138              
139             =item * Search CPAN
140              
141             L
142              
143             =back
144              
145             =head1 LICENSE AND COPYRIGHT
146              
147             Copyright 2019 Nigel Horne.
148              
149             Usage is subject to licence terms.
150              
151             The licence terms of this software are as follows:
152              
153             * Personal single user, single computer use: GPL2
154             * All other users (including Commercial, Charity, Educational, Government)
155             must apply in writing for a licence for use from Nigel Horne at the
156             above e-mail.
157              
158             =cut
159              
160             1;