view release on metacpan or  search on metacpan

lib/App/Info/Util.pm  view on Meta::CPAN

=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);

Functionally 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.exe', @paths);
  $exe = $util->first_cat_exe(['this.exe', 'that.exe'], @paths);

Functionally 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 yield 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 parenthetically
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 require Carp && 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 files_in_dir

  my @files = $util->files_in_dir($dir);
     @files = $util->files_in_dir($dir, $filter);
  my $files = $util->files_in_dir($dir);
     $files = $util->files_in_dir($dir, $filter);

Returns an list or array reference of all of the files and directories in the
file system directory C<$dir>. An optional second argument is a code reference
that filters the files. The code reference should examine the C<$_> for a file
name and return true if it's a file that you're interested and false if it's
not.

=cut

sub files_in_dir {
    my ($self, $dir, $code) = @_;
    return unless $dir;
    local *DIR;
    opendir DIR, $dir or require Carp && Carp::croak("Cannot open $dir: $!\n");
    my @files = $code
        ? grep { $code->() } readdir DIR
        : readdir DIR;
    closedir DIR;
    return wantarray ? @files : \@files;
}

##############################################################################

=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 method opens C<$file> and parses it for regular
expression 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 references, 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 require Carp && 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};
}

##############################################################################

=head2 lib_dirs