diff options
Diffstat (limited to 'install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm')
| -rw-r--r-- | install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm | 456 |
1 files changed, 456 insertions, 0 deletions
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm new file mode 100644 index 0000000..553ee2e --- /dev/null +++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm @@ -0,0 +1,456 @@ +package App::Info::Util; + +# $Id: Util.pm,v 1.1.2.1 2004-04-29 09:40:08 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 |