File Coverage

blib/lib/File/pfopen.pm
Criterion Covered Total %
statement 31 31 100.0
branch 11 12 91.6
condition n/a
subroutine 4 4 100.0
pod 0 1 0.0
total 46 48 95.8


line stmt bran cond sub pod time code
1             package File::pfopen;
2              
3             # Author Nigel Horne: njh@bandsman.co.uk
4             # Copyright (C) 2017 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   103301 use strict;
  2         2  
  2         49  
14 2     2   6 use warnings;
  2         2  
  2         41  
15 2     2   6 use File::Spec;
  2         4  
  2         510  
16              
17             require Exporter;
18             our @ISA = ('Exporter');
19             our @EXPORT_OK = ('pfopen');
20              
21             =head1 NAME
22              
23             File::pfopen - Try hard to find a file
24              
25             =head1 VERSION
26              
27             Version 0.01
28              
29             =cut
30              
31             our $VERSION = '0.01';
32              
33             =head1 SYNOPSIS
34              
35             use File::pfopen 'pfopen';
36             my $f = pfopen('/tmp:/var/tmp:/home/njh/tmp', 'foo', 'txt:bin' );
37             $f = pfopen('/tmp:/var/tmp:/home/njh/tmp', 'foo');
38              
39             =cut
40              
41             sub pfopen {
42 10     10 0 1033 my $path = shift;
43 10         11 my $prefix = shift;
44 10         8 my $suffixes = shift;
45              
46 10         4 our $savedpaths;
47              
48 10         10 my $candidate;
49 10 100       12 if(defined($suffixes)) {
50 7         14 $candidate = "$prefix;$path;$suffixes";
51             } else {
52 3         5 $candidate = "$prefix;$path";
53             }
54 10 100       19 if($savedpaths->{$candidate}) {
55             # $self->_log({ message => "remembered $savedpaths->{$candidate}" });
56 1         4 return $savedpaths->{$candidate};
57             }
58              
59 9         20 foreach my $dir(split(/:/, $path)) {
60 12 50       132 next unless(-d $dir);
61 12 100       118 if($suffixes) {
    100          
62 7         10 foreach my $suffix(split(/:/, $suffixes)) {
63             # $self->_log({ message => "check for file $dir/$prefix.$suffix" });
64 10         62 my $rc = File::Spec->catfile($dir, "$prefix.$suffix");
65 10 100       229 if(-r $rc) {
66 3         7 $savedpaths->{$candidate} = $rc;
67 3         13 return $rc;
68             }
69             }
70             } elsif(-r "$dir/$prefix") {
71 2         16 my $rc = File::Spec->catfile($dir, $prefix);
72 2         5 $savedpaths->{$candidate} = $rc;
73             # $self->_log({ message => "using $rc" });
74 2         7 return $rc;
75             }
76             }
77 4         19 return;
78             }
79              
80             =head1 AUTHOR
81              
82             Nigel Horne, C<< >>
83              
84             =head1 BUGS
85              
86             Please report any bugs or feature requests to C,
87             or through the web interface at
88             L.
89             I will be notified, and then you'll
90             automatically be notified of progress on your bug as I make changes.
91              
92             =head1 SEE ALSO
93              
94             =head1 SUPPORT
95              
96             You can find documentation for this module with the perldoc command.
97              
98             perldoc File::pfopen
99              
100             You can also look for information at:
101              
102             =over 4
103              
104             =item * RT: CPAN's request tracker
105              
106             L
107              
108             =item * AnnoCPAN: Annotated CPAN documentation
109              
110             L
111              
112             =item * CPAN Ratings
113              
114             L
115              
116             =item * Search CPAN
117              
118             L
119              
120             =back
121              
122             =head1 LICENSE AND COPYRIGHT
123              
124             Copyright 2017 Nigel Horne.
125              
126             Usage is subject to licence terms.
127              
128             The licence terms of this software are as follows:
129              
130             * Personal single user, single computer use: GPL2
131             * All other users (including Commercial, Charity, Educational, Government)
132             must apply in writing for a licence for use from Nigel Horne at the
133             above e-mail.
134              
135             =cut
136              
137             1;