File Coverage

blib/lib/App/Info/Util.pm
Criterion Covered Total %
statement 53 86 61.6
branch 18 56 32.1
condition 3 24 12.5
subroutine 10 16 62.5
pod 12 12 100.0
total 96 194 49.5


line stmt bran cond sub pod time code
1             package App::Info::Util;
2              
3             # $Id: Util.pm 3176 2006-09-25 16:00:28Z theory $
4              
5             =head1 NAME
6            
7             App::Info::Util - Utility class for App::Info subclasses
8            
9             =head1 SYNOPSIS
10            
11             use App::Info::Util;
12            
13             my $util = App::Info::Util->new;
14            
15             # Subclasses File::Spec.
16             my @paths = $util->paths;
17            
18             # First directory that exists in a list.
19             my $dir = $util->first_dir(@paths);
20            
21             # First directory that exists in a path.
22             $dir = $util->first_path($ENV{PATH});
23            
24             # First file that exists in a list.
25             my $file = $util->first_file('this.txt', '/that.txt', 'C:\\foo.txt');
26            
27             # First file found among file base names and directories.
28             my $files = ['this.txt', 'that.txt'];
29             $file = $util->first_cat_file($files, @paths);
30            
31             =head1 DESCRIPTION
32            
33             This class subclasses L<File::Spec|File::Spec> and adds its own methods in
34             order to offer utility methods to L<App::Info|App::Info> classes. Although
35             intended to be used by App::Info subclasses, in truth App::Info::Util's
36             utility may be considered more general, so feel free to use it elsewhere.
37            
38             The methods added in addition to the usual File::Spec suspects are designed to
39             facilitate locating files and directories on the file system, as well as
40             searching those files. The assumption is that, in order to provide useful
41             metadata about a given software package, an App::Info subclass must find
42             relevant files and directories and parse them with regular expressions. This
43             class offers methods that simplify those tasks.
44            
45             =cut
46              
47 2     2   27 use strict;
  2         18  
  2         28  
48 2     2   29 use File::Spec ();
  2         18  
  2         19  
49 2     2   136 use Config;
  2         23  
  2         38  
50 2     2   31 use vars qw(@ISA $VERSION);
  2         18  
  2         26  
51             @ISA = qw(File::Spec);
52             $VERSION = '0.51';
53              
54             my %path_dems = (MacOS => qr',',
55                              MSWin32 => qr';',
56                              os2 => qr';',
57                              VMS => undef,
58                              epoc => undef);
59              
60             my $path_dem = exists $path_dems{$^O} ? $path_dems{$^O} : qr':';
61              
62             =head1 CONSTRUCTOR
63            
64             =head2 new
65            
66             my $util = App::Info::Util->new;
67            
68             This is a very simple constructor that merely returns an App::Info::Util
69             object. Since, like its File::Spec super class, App::Info::Util manages no
70             internal data itself, all methods may be used as class methods, if one prefers
71             to. The constructor here is provided merely as a convenience.
72            
73             =cut
74              
75 2   33 2 1 48 sub new { bless {}, ref $_[0] || $_[0] }
76              
77             ##############################################################################
78              
79             =head1 OBJECT METHODS
80            
81             In addition to all of the methods offered by its super class,
82             L<File::Spec|File::Spec>, App::Info::Util offers the following methods.
83            
84             =head2 first_dir
85            
86             my @paths = $util->paths;
87             my $dir = $util->first_dir(@dirs);
88            
89             Returns the first file system directory in @paths that exists on the local
90             file system. Only the first item in @paths that exists as a directory will be
91             returned; any other paths leading to non-directories will be ignored.
92            
93             =cut
94              
95             sub first_dir {
96 4     4 1 273     shift;
97 4 50       41     foreach (@_) { return $_ if -d }
  4         143  
98 0         0     return;
99             }
100              
101             ##############################################################################
102              
103             =head2 first_path
104            
105             my $path = $ENV{PATH};
106             $dir = $util->first_path($path);
107            
108             Takes the $path string and splits it into a list of directory paths, based on
109             the path demarcator on the local file system. Then calls C<first_dir()> to
110             return the first directoy in the path list that exists on the local file
111             system. The path demarcator is specified for the following file systems:
112            
113             =over 4
114            
115             =item MacOS: ","
116            
117             =item MSWin32: ";"
118            
119             =item os2: ";"
120            
121             =item VMS: undef
122            
123             This method always returns undef on VMS. Patches welcome.
124            
125             =item epoc: undef
126            
127             This method always returns undef on epoch. Patches welcome.
128            
129             =item Unix: ":"
130            
131             All other operating systems are assumed to be Unix-based.
132            
133             =back
134            
135             =cut
136              
137             sub first_path {
138 0 0   0 1 0     return unless $path_dem;
139 0         0     shift->first_dir(split /$path_dem/, shift)
140             }
141              
142             ##############################################################################
143              
144             =head2 first_file
145            
146             my $file = $util->first_file(@filelist);
147            
148             Examines each of the files in @filelist and returns the first one that exists
149             on the file system. The file must be a regular file -- directories will be
150             ignored.
151            
152             =cut
153              
154             sub first_file {
155 0     0 1 0     shift;
156 0 0       0     foreach (@_) { return $_ if -f }
  0         0  
157 0         0     return;
158             }
159              
160             ##############################################################################
161              
162             =head2 first_exe
163            
164             my $exe = $util->first_exe(@exelist);
165            
166             Examines each of the files in @exelist and returns the first one that exists
167             on the file system as an executable file. Directories will be ignored.
168            
169             =cut
170              
171             sub first_exe {
172 0     0 1 0     shift;
173 0 0 0     0     foreach (@_) { return $_ if -f && -x }
  0         0  
174 0         0     return;
175             }
176              
177             ##############################################################################
178              
179             =head2 first_cat_path
180            
181             my $file = $util->first_cat_path('ick.txt', @paths);
182             $file = $util->first_cat_path(['this.txt', 'that.txt'], @paths);
183            
184             The first argument to this method may be either a file or directory base name
185             (that is, a file or directory name without a full path specification), or a
186             reference to an array of file or directory base names. The remaining arguments
187             constitute a list of directory paths. C<first_cat_path()> processes each of
188             these directory paths, concatenates (by the method native to the local
189             operating system) each of the file or directory base names, and returns the
190             first one that exists on the file system.
191            
192             For example, let us say that we were looking for a file called either F<httpd>
193             or F<apache>, and it could be in any of the following paths:
194             F</usr/local/bin>, F</usr/bin/>, F</bin>. The method call looks like this:
195            
196             my $httpd = $util->first_cat_path(['httpd', 'apache'], '/usr/local/bin',
197             '/usr/bin/', '/bin');
198            
199             If the OS is a Unix variant, C<first_cat_path()> will then look for the first
200             file that exists in this order:
201            
202             =over 4
203            
204             =item /usr/local/bin/httpd
205            
206             =item /usr/local/bin/apache
207            
208             =item /usr/bin/httpd
209            
210             =item /usr/bin/apache
211            
212             =item /bin/httpd
213            
214             =item /bin/apache
215            
216             =back
217            
218             The first of these complete paths to be found will be returned. If none are
219             found, then undef will be returned.
220            
221             =cut
222              
223             sub first_cat_path {
224 2     2 1 22     my $self = shift;
225 2 50       27     my $files = ref $_[0] ? shift() : [shift()];
226 2         56     foreach my $p (@_) {
227 2         21         foreach my $f (@$files) {
228 2         26             my $path = $self->catfile($p, $f);
229 2 50       124             return $path if -e $path;
230                     }
231                 }
232 0         0     return;
233             }
234              
235             ##############################################################################
236              
237             =head2 first_cat_dir
238            
239             my $dir = $util->first_cat_dir('ick.txt', @paths);
240             $dir = $util->first_cat_dir(['this.txt', 'that.txt'], @paths);
241            
242             Funtionally identical to C<first_cat_path()>, except that it returns the
243             directory path in which the first file was found, rather than the full
244             concatenated path. Thus, in the above example, if the file found was
245             F</usr/bin/httpd>, while C<first_cat_path()> would return that value,
246             C<first_cat_dir()> would return F</usr/bin> instead.
247            
248             =cut
249              
250             sub first_cat_dir {
251 0     0 1 0     my $self = shift;
252 0 0       0     my $files = ref $_[0] ? shift() : [shift()];
253 0         0     foreach my $p (@_) {
254 0         0         foreach my $f (@$files) {
255 0         0             my $path = $self->catfile($p, $f);
256 0 0       0             return $p if -e $path;
257                     }
258                 }
259 0         0     return;
260             }
261              
262             ##############################################################################
263              
264             =head2 first_cat_exe
265            
266             my $exe = $util->first_cat_exe('ick.exe', @paths);
267             $exe = $util->first_cat_exe(['this.exe', 'that.exe'], @paths);
268            
269             Funtionally identical to C<first_cat_path()>, except that it returns the full
270             path to the first executable file found, rather than simply the first file
271             found.
272            
273             =cut
274              
275             sub first_cat_exe {
276 4     4 1 74     my $self = shift;
277 4 50       106     my $files = ref $_[0] ? shift() : [shift()];
278 4         73     foreach my $p (@_) {
279 4         40         foreach my $f (@$files) {
280 4         67             my $path = $self->catfile($p, $f);
281 4 50 33     320             return $path if -f $path && -x $path;
282                     }
283                 }
284 0         0     return;
285             }
286              
287             ##############################################################################
288              
289             =head2 search_file
290            
291             my $file = 'foo.txt';
292             my $regex = qr/(text\s+to\s+find)/;
293             my $value = $util->search_file($file, $regex);
294            
295             Opens C<$file> and executes the C<$regex> regular expression against each line
296             in the file. Once the line matches and one or more values is returned by the
297             match, the file is closed and the value or values returned.
298            
299             For example, say F<foo.txt> contains the line "Version 6.5, patch level 8",
300             and you need to grab each of the three version parts. All three parts can
301             be grabbed like this:
302            
303             my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
304             my @nums = $util->search_file($file, $regex);
305            
306             Now C<@nums> will contain the values C<(6, 5, 8)>. Note that in a scalar
307             context, the above search would yeild an array reference:
308            
309             my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
310             my $nums = $util->search_file($file, $regex);
311            
312             So now C<$nums> contains C<[6, 5, 8]>. The same does not hold true if the
313             match returns only one value, however. Say F<foo.txt> contains the line
314             "king of the who?", and you wish to know who the king is king of. Either
315             of the following two calls would get you the data you need:
316            
317             my $minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
318             my @minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
319            
320             In the first case, because the regular expression contains only one set of
321             parentheses, C<search_file()> will simply return that value: C<$minions>
322             contains the string "the who?". In the latter case, C<@minions> of course
323             contains a single element: C<("the who?")>.
324            
325             Note that a regular expression without parentheses -- that is, one that
326             doesn't grab values and put them into $1, $2, etc., will never successfully
327             match a line in this method. You must include something to parentetically
328             match. If you just want to know the value of what was matched, parenthesize
329             the whole thing and if the value returns, you have a match. Also, if you need
330             to match patterns across lines, try using multiple regular expressions with
331             C<multi_search_file()>, instead.
332            
333             =cut
334              
335             sub search_file {
336 0     0 1 0     my ($self, $file, $regex) = @_;
337 0 0 0     0     return unless $file && $regex;
338 0 0 0     0     open F, "<$file" or require Carp && Carp::croak("Cannot open $file: $!\n");
339 0         0     my @ret;
340 0         0     while (<F>) {
341             # If we find a match, we're done.
342 0 0       0         (@ret) = /$regex/ and last;
343                 }
344 0         0     close F;
345             # If the match returned an more than one value, always return the full
346             # array. Otherwise, return just the first value in a scalar context.
347 0 0       0     return unless @ret;
348 0 0       0     return wantarray ? @ret : $#ret <= 0 ? $ret[0] : \@ret;
    0          
349             }
350              
351             ##############################################################################
352              
353             =head2 files_in_dir
354            
355             my @files = $util->files_in_dir($dir);
356             @files = $util->files_in_dir($dir, $filter);
357             my $files = $util->files_in_dir($dir);
358             $files = $util->files_in_dir($dir, $filter);
359            
360             Returns an list or array reference of all of the files and directories in the
361             file system directory C<$dir>. An optional second argument is a code reference
362             that filters the files. The code reference should examine the C<$_> for a file
363             name and return true if it's a file that you're interested and false if it's
364             not.
365            
366             =cut
367              
368             sub files_in_dir {
369 1     1 1 31     my ($self, $dir, $code) = @_;
370 1 50       33     return unless $dir;
371 1         47     local *DIR;
372 1 50 0     579     opendir DIR, $dir or require Carp && Carp::croak("Cannot open $dir: $!\n");
373 6         103     my @files = $code
374 1 50       137         ? grep { $code->() } readdir DIR
375                     : readdir DIR;
376 1         21     closedir DIR;
377 1 50       30     return wantarray ? @files : \@files;
378             }
379              
380             ##############################################################################
381              
382             =head2 multi_search_file
383            
384             my @regexen = (qr/(one)/, qr/(two)\s+(three)/);
385             my @matches = $util->multi_search_file($file, @regexen);
386            
387             Like C<search_file()>, this mehod opens C<$file> and parses it for regular
388             expresion matches. This method, however, can take a list of regular
389             expressions to look for, and will return the values found for all of them.
390             Regular expressions that match and return multiple values will be returned as
391             array referernces, while those that match and return a single value will
392             return just that single value.
393            
394             For example, say you are parsing a file with lines like the following:
395            
396             #define XML_MAJOR_VERSION 1
397             #define XML_MINOR_VERSION 95
398             #define XML_MICRO_VERSION 2
399            
400             You need to get each of these numbers, but calling C<search_file()> for each
401             of them would be wasteful, as each call to C<search_file()> opens the file and
402             parses it. With C<multi_search_file()>, on the other hand, the file will be
403             opened only once, and, once all of the regular expressions have returned
404             matches, the file will be closed and the matches returned.
405            
406             Thus the above values can be collected like this:
407            
408             my @regexen = ( qr/XML_MAJOR_VERSION\s+(\d+)$/,
409             qr/XML_MINOR_VERSION\s+(\d+)$/,