--- /dev/null
+package App::Info::Util;
+
+# $Id: Util.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+=head1 NAME
+
+App::Info::Util - Utility class for App::Info subclasses
+
+=head1 SYNOPSIS
+
+ use App::Info::Util;
+
+ my $util = App::Info::Util->new;
+
+ # Subclasses File::Spec.
+ my @paths = $util->paths;
+
+ # First directory that exists in a list.
+ my $dir = $util->first_dir(@paths);
+
+ # First directory that exists in a path.
+ $dir = $util->first_path($ENV{PATH});
+
+ # First file that exists in a list.
+ my $file = $util->first_file('this.txt', '/that.txt', 'C:\\foo.txt');
+
+ # First file found among file base names and directories.
+ my $files = ['this.txt', 'that.txt'];
+ $file = $util->first_cat_file($files, @paths);
+
+=head1 DESCRIPTION
+
+This class subclasses L<File::Spec|File::Spec> and adds its own methods in
+order to offer utility methods to L<App::Info|App::Info> classes. Although
+intended to be used by App::Info subclasses, in truth App::Info::Util's
+utility may be considered more general, so feel free to use it elsewhere.
+
+The methods added in addition to the usual File::Spec suspects are designed to
+facilitate locating files and directories on the file system, as well as
+searching those files. The assumption is that, in order to provide useful
+metadata about a given software package, an App::Info subclass must find
+relevant files and directories and parse them with regular expressions. This
+class offers methods that simplify those tasks.
+
+=cut
+
+use strict;
+use File::Spec ();
+use vars qw(@ISA $VERSION);
+@ISA = qw(File::Spec);
+$VERSION = '0.22';
+
+my %path_dems = (MacOS => qr',',
+ MSWin32 => qr';',
+ os2 => qr';',
+ VMS => undef,
+ epoc => undef);
+
+my $path_dem = exists $path_dems{$^O} ? $path_dems{$^O} : qr':';
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+ my $util = App::Info::Util->new;
+
+This is a very simple constructor that merely returns an App::Info::Util
+object. Since, like its File::Spec super class, App::Info::Util manages no
+internal data itself, all methods may be used as class methods, if one prefers
+to. The constructor here is provided merely as a convenience.
+
+=cut
+
+sub new { bless {}, ref $_[0] || $_[0] }
+
+=head1 OBJECT METHODS
+
+In addition to all of the methods offered by its super class,
+L<File::Spec|File::Spec>, App::Info::Util offers the following methods.
+
+=head2 first_dir
+
+ my @paths = $util->paths;
+ my $dir = $util->first_dir(@dirs);
+
+Returns the first file system directory in @paths that exists on the local
+file system. Only the first item in @paths that exists as a directory will be
+returned; any other paths leading to non-directories will be ignored.
+
+=cut
+
+sub first_dir {
+ shift;
+ foreach (@_) { return $_ if -d }
+ return;
+}
+
+=head2 first_path
+
+ my $path = $ENV{PATH};
+ $dir = $util->first_path($path);
+
+Takes the $path string and splits it into a list of directory paths, based on
+the path demarcator on the local file system. Then calls C<first_dir()> to
+return the first directoy in the path list that exists on the local file
+system. The path demarcator is specified for the following file systems:
+
+=over 4
+
+=item MacOS: ","
+
+=item MSWin32: ";"
+
+=item os2: ";"
+
+=item VMS: undef
+
+This method always returns undef on VMS. Patches welcome.
+
+=item epoc: undef
+
+This method always returns undef on epoch. Patches welcome.
+
+=item Unix: ":"
+
+All other operating systems are assumed to be Unix-based.
+
+=back
+
+=cut
+
+sub first_path {
+ return unless $path_dem;
+ shift->first_dir(split /$path_dem/, shift)
+}
+
+=head2 first_file
+
+ my $file = $util->first_file(@filelist);
+
+Examines each of the files in @filelist and returns the first one that exists
+on the file system. The file must be a regular file -- directories will be
+ignored.
+
+=cut
+
+sub first_file {
+ shift;
+ foreach (@_) { return $_ if -f }
+ return;
+}
+
+=head2 first_exe
+
+ my $exe = $util->first_exe(@exelist);
+
+Examines each of the files in @exelist and returns the first one that exists
+on the file system as an executable file. Directories will be ignored.
+
+=cut
+
+sub first_exe {
+ shift;
+ foreach (@_) { return $_ if -f && -x }
+ return;
+}
+
+=head2 first_cat_path
+
+ my $file = $util->first_cat_path('ick.txt', @paths);
+ $file = $util->first_cat_path(['this.txt', 'that.txt'], @paths);
+
+The first argument to this method may be either a file or directory base name
+(that is, a file or directory name without a full path specification), or a
+reference to an array of file or directory base names. The remaining arguments
+constitute a list of directory paths. C<first_cat_path()> processes each of
+these directory paths, concatenates (by the method native to the local
+operating system) each of the file or directory base names, and returns the
+first one that exists on the file system.
+
+For example, let us say that we were looking for a file called either F<httpd>
+or F<apache>, and it could be in any of the following paths:
+F</usr/local/bin>, F</usr/bin/>, F</bin>. The method call looks like this:
+
+ my $httpd = $util->first_cat_path(['httpd', 'apache'], '/usr/local/bin',
+ '/usr/bin/', '/bin');
+
+If the OS is a Unix variant, C<first_cat_path()> will then look for the first
+file that exists in this order:
+
+=over 4
+
+=item /usr/local/bin/httpd
+
+=item /usr/local/bin/apache
+
+=item /usr/bin/httpd
+
+=item /usr/bin/apache
+
+=item /bin/httpd
+
+=item /bin/apache
+
+=back
+
+The first of these complete paths to be found will be returned. If none are
+found, then undef will be returned.
+
+=cut
+
+sub first_cat_path {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $path if -e $path;
+ }
+ }
+ return;
+}
+
+=head2 first_cat_dir
+
+ my $dir = $util->first_cat_dir('ick.txt', @paths);
+ $dir = $util->first_cat_dir(['this.txt', 'that.txt'], @paths);
+
+Funtionally identical to C<first_cat_path()>, except that it returns the
+directory path in which the first file was found, rather than the full
+concatenated path. Thus, in the above example, if the file found was
+F</usr/bin/httpd>, while C<first_cat_path()> would return that value,
+C<first_cat_dir()> would return F</usr/bin> instead.
+
+=cut
+
+sub first_cat_dir {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $p if -e $path;
+ }
+ }
+ return;
+}
+
+=head2 first_cat_exe
+
+ my $exe = $util->first_cat_exe('ick.txt', @paths);
+ $exe = $util->first_cat_exe(['this.txt', 'that.txt'], @paths);
+
+Funtionally identical to C<first_cat_path()>, except that it returns the full
+path to the first executable file found, rather than simply the first file
+found.
+
+=cut
+
+sub first_cat_exe {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $path if -f $path && -x $path;
+ }
+ }
+ return;
+}
+
+=head2 search_file
+
+ my $file = 'foo.txt';
+ my $regex = qr/(text\s+to\s+find)/;
+ my $value = $util->search_file($file, $regex);
+
+Opens C<$file> and executes the C<$regex> regular expression against each line
+in the file. Once the line matches and one or more values is returned by the
+match, the file is closed and the value or values returned.
+
+For example, say F<foo.txt> contains the line "Version 6.5, patch level 8",
+and you need to grab each of the three version parts. All three parts can
+be grabbed like this:
+
+ my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
+ my @nums = $util->search_file($file, $regex);
+
+Now C<@nums> will contain the values C<(6, 5, 8)>. Note that in a scalar
+context, the above search would yeild an array reference:
+
+ my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
+ my $nums = $util->search_file($file, $regex);
+
+So now C<$nums> contains C<[6, 5, 8]>. The same does not hold true if the
+match returns only one value, however. Say F<foo.txt> contains the line
+"king of the who?", and you wish to know who the king is king of. Either
+of the following two calls would get you the data you need:
+
+ my $minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
+ my @minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
+
+In the first case, because the regular expression contains only one set of
+parentheses, C<search_file()> will simply return that value: C<$minions>
+contains the string "the who?". In the latter case, C<@minions> of course
+contains a single element: C<("the who?")>.
+
+Note that a regular expression without parentheses -- that is, one that
+doesn't grab values and put them into $1, $2, etc., will never successfully
+match a line in this method. You must include something to parentetically
+match. If you just want to know the value of what was matched, parenthesize
+the whole thing and if the value returns, you have a match. Also, if you need
+to match patterns across lines, try using multiple regular expressions with
+C<multi_search_file()>, instead.
+
+=cut
+
+sub search_file {
+ my ($self, $file, $regex) = @_;
+ return unless $file && $regex;
+ open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
+ my @ret;
+ while (<F>) {
+ # If we find a match, we're done.
+ (@ret) = /$regex/ and last;
+ }
+ close F;
+ # If the match returned an more than one value, always return the full
+ # array. Otherwise, return just the first value in a scalar context.
+ return unless @ret;
+ return wantarray ? @ret : $#ret <= 0 ? $ret[0] : \@ret;
+}
+
+=head2 multi_search_file
+
+ my @regexen = (qr/(one)/, qr/(two)\s+(three)/);
+ my @matches = $util->multi_search_file($file, @regexen);
+
+Like C<search_file()>, this mehod opens C<$file> and parses it for regular
+expresion matches. This method, however, can take a list of regular
+expressions to look for, and will return the values found for all of them.
+Regular expressions that match and return multiple values will be returned as
+array referernces, while those that match and return a single value will
+return just that single value.
+
+For example, say you are parsing a file with lines like the following:
+
+ #define XML_MAJOR_VERSION 1
+ #define XML_MINOR_VERSION 95
+ #define XML_MICRO_VERSION 2
+
+You need to get each of these numbers, but calling C<search_file()> for each
+of them would be wasteful, as each call to C<search_file()> opens the file and
+parses it. With C<multi_search_file()>, on the other hand, the file will be
+opened only once, and, once all of the regular expressions have returned
+matches, the file will be closed and the matches returned.
+
+Thus the above values can be collected like this:
+
+ my @regexen = ( qr/XML_MAJOR_VERSION\s+(\d+)$/,
+ qr/XML_MINOR_VERSION\s+(\d+)$/,
+ qr/XML_MICRO_VERSION\s+(\d+)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+The result will be that C<@nums> contains C<(1, 95, 2)>. Note that
+C<multi_file_search()> tries to do the right thing by only parsing the file
+until all of the regular expressions have been matched. Thus, a large file
+with the values you need near the top can be parsed very quickly.
+
+As with C<search_file()>, C<multi_search_file()> can take regular expressions
+that match multiple values. These will be returned as array references. For
+example, say the file you're parsing has files like this:
+
+ FooApp Version 4
+ Subversion 2, Microversion 6
+
+To get all of the version numbers, you can either use three regular
+expressions, as in the previous example:
+
+ my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
+ qr/Subversion\s+(\d+),/,
+ qr/Microversion\s+(\d$)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+In which case C<@nums> will contain C<(4, 2, 6)>. Or, you can use just two
+regular expressions:
+
+ my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
+ qr/Subversion\s+(\d+),\s+Microversion\s+(\d$)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+In which case C<@nums> will contain C<(4, [2, 6])>. Note that the two
+parentheses that return values in the second regular expression cause the
+matches to be returned as an array reference.
+
+=cut
+
+sub multi_search_file {
+ my ($self, $file, @regexen) = @_;
+ return unless $file && @regexen;
+ my @each = @regexen;
+ open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
+ my %ret;
+ while (my $line = <F>) {
+ my @splice;
+ # Process each of the regular expresssions.
+ for (my $i = 0; $i < @each; $i++) {
+ if ((my @ret) = $line =~ /$each[$i]/) {
+ # We have a match! If there's one match returned, just grab
+ # it. If there's more than one, keep it as an array ref.
+ $ret{$each[$i]} = $#ret > 0 ? \@ret : $ret[0];
+ # We got values for this regex, so not its place in the @each
+ # array.
+ push @splice, $i;
+ }
+ }
+ # Remove any regexen that have already found a match.
+ for (@splice) { splice @each, $_, 1 }
+ # If there are no more regexes, we're done -- no need to keep
+ # processing lines in the file!
+ last unless @each;
+ }
+ close F;
+ return unless %ret;
+ return wantarray ? @ret{@regexen} : \@ret{@regexen};
+}
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info>, L<File::Spec|File::Spec>,
+L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache>
+L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
projects / freeside.git / blobdiff