diff options
Diffstat (limited to 'install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App')
7 files changed, 0 insertions, 3170 deletions
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm deleted file mode 100644 index 417247f..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm +++ /dev/null @@ -1,1167 +0,0 @@ -package App::Info; - -# $Id: Info.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $ - -=head1 NAME - -App::Info - Information about software packages on a system - -=head1 SYNOPSIS - - use App::Info::Category::FooApp; - - my $app = App::Info::Category::FooApp->new; - - if ($app->installed) { - print "App name: ", $app->name, "\n"; - print "Version: ", $app->version, "\n"; - print "Bin dir: ", $app->bin_dir, "\n"; - } else { - print "App not installed on your system. :-(\n"; - } - -=head1 DESCRIPTION - -App::Info is an abstract base class designed to provide a generalized -interface for subclasses that provide metadata about software packages -installed on a system. The idea is that these classes can be used in Perl -application installers in order to determine whether software dependencies -have been fulfilled, and to get necessary metadata about those software -packages. - -App::Info provides an event model for handling events triggered by App::Info -subclasses. The events are classified as "info", "error", "unknown", and -"confirm" events, and multiple handlers may be specified to handle any or all -of these event types. This allows App::Info clients to flexibly handle events -in any way they deem necessary. Implementing new event handlers is -straight-forward, and use the triggering of events by App::Info subclasses is -likewise kept easy-to-use. - -A few L<sample subclasses|"SEE ALSO"> are provided with the distribution, but -others are invited to write their own subclasses and contribute them to the -CPAN. Contributors are welcome to extend their subclasses to provide more -information relevant to the application for which data is to be provided (see -L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache> for an example), but are -encouraged to, at a minimum, implement the abstract methods defined here and -in the category abstract base classes (e.g., -L<App::Info::HTTPD|App::Info::HTTPD> and L<App::Info::Lib|App::Info::Lib>). -See L<Subclassing|"SUBCLASSING"> for more information on implementing new -subclasses. - -=cut - -use strict; -use Carp (); -use App::Info::Handler; -use App::Info::Request; -use vars qw($VERSION); - -$VERSION = '0.23'; - -############################################################################## -############################################################################## -# This code ref is used by the abstract methods to throw an exception when -# they're called directly. -my $croak = sub { - my ($caller, $meth) = @_; - $caller = ref $caller || $caller; - if ($caller eq __PACKAGE__) { - $meth = __PACKAGE__ . '::' . $meth; - Carp::croak(__PACKAGE__ . " is an abstract base class. Attempt to " . - " call non-existent method $meth"); - } else { - Carp::croak("Class $caller inherited from the abstract base class " . - __PACKAGE__ . ", but failed to redefine the $meth() " . - "method. Attempt to call non-existent method " . - "${caller}::$meth"); - } -}; - -############################################################################## -# This code reference is used by new() and the on_* error handler methods to -# set the error handlers. -my $set_handlers = sub { - my $on_key = shift; - # Default is to do nothing. - return [] unless $on_key; - my $ref = ref $on_key; - if ($ref) { - $on_key = [$on_key] unless $ref eq 'ARRAY'; - # Make sure they're all handlers. - foreach my $h (@$on_key) { - if (my $r = ref $h) { - Carp::croak("$r object is not an App::Info::Handler") - unless UNIVERSAL::isa($h, 'App::Info::Handler'); - } else { - # Look up the handler. - $h = App::Info::Handler->new( key => $h); - } - } - # Return 'em! - return $on_key; - } else { - # Look up the handler. - return [ App::Info::Handler->new( key => $on_key) ]; - } -}; - -############################################################################## -############################################################################## - -=head1 INTERFACE - -This section documents the public interface of App::Info. - -=head2 Constructor - -=head3 new - - my $app = App::Info::Category::FooApp->new(@params); - -Constructs an App::Info object and returns it. The @params arguments define -how the App::Info object will respond to certain events, and correspond to -their like-named methods. See the L<"Event Handler Object Methods"> section -for more information on App::Info events and how to handle them. The -parameters to C<new()> for the different types of App::Info events are: - -=over 4 - -=item on_info - -=item on_error - -=item on_unknown - -=item on_confirm - -=back - -When passing event handlers to C<new()>, the list of handlers for each type -should be an anonymous array, for example: - - my $app = App::Info::Category::FooApp->new( on_info => \@handlers ); - -=cut - -sub new { - my ($pkg, %p) = @_; - my $class = ref $pkg || $pkg; - # Fail if the method isn't overridden. - $croak->($pkg, 'new') if $class eq __PACKAGE__; - - # Set up handlers. - for (qw(on_error on_unknown on_info on_confirm)) { - $p{$_} = $set_handlers->($p{$_}); - } - - # Do it! - return bless \%p, $class; -} - -############################################################################## -############################################################################## - -=head2 Metadata Object Methods - -These are abstract methods in App::Info and must be provided by its -subclasses. They provide the essential metadata of the software package -supported by the App::Info subclass. - -=head3 key_name - - my $key_name = $app->key_name; - -Returns a string that uniquely identifies the software for which the App::Info -subclass provides data. This value should be unique across all App::Info -classes. Typically, it's simply the name of the software. - -=cut - -sub key_name { $croak->(shift, 'key_name') } - -=head3 installed - - if ($app->installed) { - print "App is installed.\n" - } else { - print "App is not installed.\n" - } - -Returns a true value if the application is installed, and a false value if it -is not. - -=cut - -sub installed { $croak->(shift, 'installed') } - -############################################################################## - -=head3 name - - my $name = $app->name; - -Returns the name of the application. - -=cut - -sub name { $croak->(shift, 'name') } - -############################################################################## - -=head3 version - - my $version = $app->version; - -Returns the full version number of the application. - -=cut - -############################################################################## - -sub version { $croak->(shift, 'version') } - -=head3 major_version - - my $major_version = $app->major_version; - -Returns the major version number of the application. For example, if -C<version()> returns "7.1.2", then this method returns "7". - -=cut - -sub major_version { $croak->(shift, 'major_version') } - -############################################################################## - -=head3 minor_version - - my $minor_version = $app->minor_version; - -Returns the minor version number of the application. For example, if -C<version()> returns "7.1.2", then this method returns "1". - -=cut - -sub minor_version { $croak->(shift, 'minor_version') } - -############################################################################## - -=head3 patch_version - - my $patch_version = $app->patch_version; - -Returns the patch version number of the application. For example, if -C<version()> returns "7.1.2", then this method returns "2". - -=cut - -sub patch_version { $croak->(shift, 'patch_version') } - -############################################################################## - -=head3 bin_dir - - my $bin_dir = $app->bin_dir; - -Returns the full path the application's bin directory, if it exists. - -=cut - -sub bin_dir { $croak->(shift, 'bin_dir') } - -############################################################################## - -=head3 inc_dir - - my $inc_dir = $app->inc_dir; - -Returns the full path the application's include directory, if it exists. - -=cut - -sub inc_dir { $croak->(shift, 'inc_dir') } - -############################################################################## - -=head3 lib_dir - - my $lib_dir = $app->lib_dir; - -Returns the full path the application's lib directory, if it exists. - -=cut - -sub lib_dir { $croak->(shift, 'lib_dir') } - -############################################################################## - -=head3 so_lib_dir - - my $so_lib_dir = $app->so_lib_dir; - -Returns the full path the application's shared library directory, if it -exists. - -=cut - -sub so_lib_dir { $croak->(shift, 'so_lib_dir') } - -############################################################################## - -=head3 home_url - - my $home_url = $app->home_url; - -The URL for the software's home page. - -=cut - -sub home_url { $croak->(shift, 'home_url') } - -############################################################################## - -=head3 download_url - - my $download_url = $app->download_url; - -The URL for the software's download page. - -=cut - -sub download_url { $croak->(shift, 'download_url') } - -############################################################################## -############################################################################## - -=head2 Event Handler Object Methods - -These methods provide control over App::Info event handling. Events can be -handled by one or more objects of subclasses of App::Info::Handler. The first -to return a true value will be the last to execute. This approach allows -handlers to be stacked, and makes it relatively easy to create new handlers. -L<App::Info::Handler|App::Info::Handler> for information on writing event -handlers. - -Each of the event handler methods takes a list of event handlers as its -arguments. If none are passed, the existing list of handlers for the relevant -event type will be returned. If new handlers are passed in, they will be -returned. - -The event handlers may be specified as one or more objects of the -App::Info::Handler class or subclasses, as one or more strings that tell -App::Info construct such handlers itself, or a combination of the two. The -strings can only be used if the relevant App::Info::Handler subclasses have -registered strings with App::Info. For example, the App::Info::Handler::Print -class included in the App::Info distribution registers the strings "stderr" -and "stdout" when it starts up. These strings may then be used to tell -App::Info to construct App::Info::Handler::Print objects that print to STDERR -or to STDOUT, respectively. See the App::Info::Handler subclasses for what -strings they register with App::Info. - -=head3 on_info - - my @handlers = $app->on_info; - $app->on_info(@handlers); - -Info events are triggered when the App::Info subclass wants to send an -informational status message. By default, these events are ignored, but a -common need is for such messages to simply print to STDOUT. Use the -L<App::Info::Handler::Print|App::Info::Handler::Print> class included with the -App::Info distribution to have info messages print to STDOUT: - - use App::Info::Handler::Print; - $app->on_info('stdout'); - # Or: - my $stdout_handler = App::Info::Handler::Print->new('stdout'); - $app->on_info($stdout_handler); - -=cut - -sub on_info { - my $self = shift; - $self->{on_info} = $set_handlers->(\@_) if @_; - return @{ $self->{on_info} }; -} - -=head3 on_error - - my @handlers = $app->on_error; - $app->on_error(@handlers); - -Error events are triggered when the App::Info subclass runs into an unexpected -but not fatal problem. (Note that fatal problems will likely throw an -exception.) By default, these events are ignored. A common way of handling -these events is to print them to STDERR, once again using the -L<App::Info::Handler::Print|App::Info::Handler::Print> class included with the -App::Info distribution: - - use App::Info::Handler::Print; - my $app->on_error('stderr'); - # Or: - my $stderr_handler = App::Info::Handler::Print->new('stderr'); - $app->on_error($stderr_handler); - -Another approach might be to turn such events into fatal exceptions. Use the -included L<App::Info::Handler::Carp|App::Info::Handler::Carp> class for this -purpose: - - use App::Info::Handler::Carp; - my $app->on_error('croak'); - # Or: - my $croaker = App::Info::Handler::Carp->new('croak'); - $app->on_error($croaker); - -=cut - -sub on_error { - my $self = shift; - $self->{on_error} = $set_handlers->(\@_) if @_; - return @{ $self->{on_error} }; -} - -=head3 on_unknown - - my @handlers = $app->on_unknown; - $app->on_uknown(@handlers); - -Unknown events are trigged when the App::Info subclass cannot find the value -to be returned by a method call. By default, these events are ignored. A -common way of handling them is to have the application prompt the user for the -relevant data. The App::Info::Handler::Prompt class included with the -App::Info distribution can do just that: - - use App::Info::Handler::Prompt; - my $app->on_unknown('prompt'); - # Or: - my $prompter = App::Info::Handler::Prompt; - $app->on_unknown($prompter); - -See L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> for information -on how it works. - -=cut - -sub on_unknown { - my $self = shift; - $self->{on_unknown} = $set_handlers->(\@_) if @_; - return @{ $self->{on_unknown} }; -} - -=head3 on_confirm - - my @handlers = $app->on_confirm; - $app->on_confirm(@handlers); - -Confirm events are triggered when the App::Info subclass has found an -important piece of information (such as the location of the executable it'll -use to collect information for the rest of its methods) and wants to confirm -that the information is correct. These events will most often be triggered -during the App::Info subclass object construction. Here, too, the -App::Info::Handler::Prompt class included with the App::Info distribution can -help out: - - use App::Info::Handler::Prompt; - my $app->on_confirm('prompt'); - # Or: - my $prompter = App::Info::Handler::Prompt; - $app->on_confirm($prompter); - -=cut - -sub on_confirm { - my $self = shift; - $self->{on_confirm} = $set_handlers->(\@_) if @_; - return @{ $self->{on_confirm} }; -} - -############################################################################## -############################################################################## - -=head1 SUBCLASSING - -As an abstract base class, App::Info is not intended to be used directly. -Instead, you'll use concrete subclasses that implement the interface it -defines. These subclasses each provide the metadata necessary for a given -software package, via the interface outlined above (plus any additional -methods the class author deems sensible for a given application). - -This section describes the facilities App::Info provides for subclassing. The -goal of the App::Info design has been to make subclassing straight-forward, so -that developers can focus on gathering the data they need for their -application and minimize the work necessary to handle unknown values or to -confirm values. As a result, there are essentially three concepts that -developers need to understand when subclassing App::Info: organization, -utility methods, and events. - -=head2 Organization - -The organizational idea behind App::Info is to name subclasses by broad -software categories. This approach allows the categories themselves to -function as abstract base classes that extend App::Info, so that they can -specify more methods for all of their base classes to implement. For example, -App::Info::HTTPD has specified the C<httpd_root()> abstract method that its -subclasses must implement. So as you get ready to implement your own subclass, -think about what category of software you're gathering information about. -New categories can be added as necessary. - -=head2 Utility Methods - -Once you've decided on the proper category, you can start implementing your -App::Info concrete subclass. As you do so, take advantage of App::Info::Util, -wherein I've tried to encapsulate common functionality to make subclassing -easier. I found that most of what I was doing repetitively was looking for -files and directories, and searching through files. Thus, App::Info::Util -subclasses L<File::Spec|File::Spec> in order to offer easy access to -commonly-used methods from that class, e.g., C<path()>. Plus, it has several -of its own methods to assist you in finding files and directories in lists of -files and directories, as well as methods for searching through files and -returning the values found in those files. See -L<App::Info::Util|App::Info::Util> for more information, and the App::Info -subclasses in this distribution for usage examples. - -I recommend the use of a package-scoped lexical App::Info::Util object. That -way it's nice and handy when you need to carry out common tasks. If you find -you're doing something over and over that's not already addressed by an -App::Info::Util method, consider submitting a patch to App::Info::Util to add -the functionality you need. - -=head2 Events - -Use the methods described below to trigger events. Events are designed to -provide a simple way for App::Info subclass developers to send status messages -and errors, to confirm data values, and to request a value when the class -caonnot determine a value itself. Events may optionally be handled by module -users who assign App::Info::Handler subclass objects to your App::Info -subclass object using the event handling methods described in the L<"Event -Handler Object Methods"> section. - -=cut - -############################################################################## -# This code reference is used by the event methods to manage the stack of -# event handlers that may be available to handle each of the events. -my $handler = sub { - my ($self, $meth, $params) = @_; - - # Sanity check. We really want to keep control over this. - Carp::croak("Cannot call protected method $meth()") - unless UNIVERSAL::isa($self, scalar caller(1)); - - # Create the request object. - $params->{type} ||= $meth; - my $req = App::Info::Request->new(%$params); - - # Do the deed. The ultimate handling handler may die. - foreach my $eh (@{$self->{"on_$meth"}}) { - last if $eh->handler($req); - } - - # Return the requst. - return $req; -}; - -############################################################################## - -=head3 info - - $self->info(@message); - -Use this method to display status messages for the user. You may wish to use -it to inform users that you're searching for a particular file, or attempting -to parse a file or some other resource for the data you need. For example, a -common use might be in the object constructor: generally, when an App::Info -object is created, some important initial piece of information is being -sought, such as an executable file. That file may be in one of many locations, -so it makes sense to let the user know that you're looking for it: - - $self->info("Searching for executable"); - -Note that, due to the nature of App::Info event handlers, your informational -message may be used or displayed any number of ways, or indeed not at all (as -is the default behavior). - -The C<@message> will be joined into a single string and stored in the -C<message> attribute of the App::Info::Request object passed to info event -handlers. - -=cut - -sub info { - my $self = shift; - # Execute the handler sequence. - my $req = $handler->($self, 'info', { message => join '', @_ }); -} - -############################################################################## - -=head3 error - - $self->error(@error); - -Use this method to inform the user that something unexpected has happened. An -example might be when you invoke another program to parse its output, but it's -output isn't what you expected: - - $self->error("Unable to parse version from `/bin/myapp -c`"); - -As with all events, keep in mind that error events may be handled in any -number of ways, or not at all. - -The C<@erorr> will be joined into a single string and stored in the C<message> -attribute of the App::Info::Request object passed to error event handlers. If -that seems confusing, think of it as an "error message" rather than an "error -error." :-) - -=cut - -sub error { - my $self = shift; - # Execute the handler sequence. - my $req = $handler->($self, 'error', { message => join '', @_ }); -} - -############################################################################## - -=head3 unknown - - my $val = $self->unknown(@params); - -Use this method when a value is unknown. This will give the user the option -- -assuming the appropriate handler handles the event -- to provide the needed -data. The value entered will be returned by C<unknown()>. The parameters are -as follows: - -=over 4 - -=item key - -The C<key> parameter uniquely identifies the data point in your class, and is -used by App::Info to ensure that an unknown event is handled only once, no -matter how many times the method is called. The same value will be returned by -subsequent calls to C<unknown()> as was returned by the first call, and no -handlers will be activated. Typical values are "version" and "lib_dir". - -=item prompt - -The C<prompt> parameter is the prompt to be displayed should an event handler -decide to prompt for the appropriate value. Such a prompt might be something -like "Path to your httpd executable?". If this parameter is not provided, -App::Info will construct one for you using your class' C<key_name()> method -and the C<key> parameter. The result would be something like "Enter a valid -FooApp version". The C<prompt> parameter value will be stored in the -C<message> attribute of the App::Info::Request object passed to event -handlers. - -=item callback - -Assuming a handler has collected a value for your unknown data point, it might -make sense to validate the value. For example, if you prompt the user for a -directory location, and the user enters one, it makes sense to ensure that the -directory actually exists. The C<callback> parameter allows you to do this. It -is a code reference that takes the new value or values as its arguments, and -returns true if the value is valid, and false if it is not. For the sake of -convenience, the first argument to the callback code reference is also stored -in C<$_> .This makes it easy to validate using functions or operators that, -er, operate on C<$_> by default, but still allows you to get more information -from C<@_> if necessary. For the directory example, a good callback might be -C<sub { -d }>. The C<callback> parameter code reference will be stored in the -C<callback> attribute of the App::Info::Request object passed to event -handlers. - -=item error - -The error parameter is the error message to display in the event that the -C<callback> code reference returns false. This message may then be used by the -event handler to let the user know what went wrong with the data she entered. -For example, if the unknown value was a directory, and the user entered a -value that the C<callback> identified as invalid, a message to display might -be something like "Invalid directory path". Note that if the C<error> -parameter is not provided, App::Info will supply the generic error message -"Invalid value". This value will be stored in the C<error> attribute of the -App::Info::Request object passed to event handlers. - -=back - -This may be the event method you use most, as it should be called in every -metadata method if you cannot provide the data needed by that method. It will -typically be the last part of the method. Here's an example demonstrating each -of the above arguments: - - my $dir = $self->unknown( key => 'lib_dir', - prompt => "Enter lib directory path", - callback => sub { -d }, - error => "Not a directory"); - -=cut - -sub unknown { - my ($self, %params) = @_; - my $key = delete $params{key} - or Carp::croak("No key parameter passed to unknown()"); - # Just return the value if we've already handled this value. Ideally this - # shouldn't happen. - return $self->{__unknown__}{$key} if exists $self->{__unknown__}{$key}; - - # Create a prompt and error message, if necessary. - $params{message} = delete $params{prompt} || - "Enter a valid " . $self->key_name . " $key"; - $params{error} ||= 'Invalid value'; - - # Execute the handler sequence. - my $req = $handler->($self, "unknown", \%params); - - # Mark that we've provided this value and then return it. - $self->{__unknown__}{$key} = $req->value; - return $self->{__unknown__}{$key}; -} - -############################################################################## - -=head3 confirm - - my $val = $self->confirm(@params); - -This method is very similar to C<unknown()>, but serves a different purpose. -Use this method for significant data points where you've found an appropriate -value, but want to ensure it's really the correct value. A "significant data -point" is usually a value essential for your class to collect metadata values. -For example, you might need to locate an executable that you can then call to -collect other data. In general, this will only happen once for an object -- -during object construction -- but there may be cases in which it is needed -more than that. But hopefully, once you've confirmed in the constructor that -you've found what you need, you can use that information to collect the data -needed by all of the metadata methods and can assume that they'll be right -because that first, significant data point has been confirmed. - -Other than where and how often to call C<confirm()>, its use is quite similar -to that of C<unknown()>. Its parameters are as follows: - -=over - -=item key - -Same as for C<unknown()>, a string that uniquely identifies the data point in -your class, and ensures that the event is handled only once for a given key. -The same value will be returned by subsequent calls to C<confirm()> as was -returned by the first call for a given key. - -=item prompt - -Same as for C<unknown()>. Although C<confirm()> is called to confirm a value, -typically the prompt should request the relevant value, just as for -C<unknown()>. The difference is that the handler I<should> use the C<value> -parameter as the default should the user not provide a value. The C<prompt> -parameter will be stored in the C<message> attribute of the App::Info::Request -object passed to event handlers. - -=item value - -The value to be confirmed. This is the value you've found, and it will be -provided to the user as the default option when they're prompted for a new -value. This value will be stored in the C<value> attribute of the -App::Info::Request object passed to event handlers. - -=item callback - -Same as for C<unknown()>. Because the user can enter data to replace the -default value provided via the C<value> parameter, you might want to validate -it. Use this code reference to do so. The callback will be stored in the -C<callback> attribute of the App::Info::Request object passed to event -handlers. - -=item error - -Same as for C<unknown()>: an error message to display in the event that a -value entered by the user isn't validated by the C<callback> code reference. -This value will be stored in the C<error> attribute of the App::Info::Request -object passed to event handlers. - -=back - -Here's an example usage demonstrating all of the above arguments: - - my $exe = $self->confirm( key => 'shell', - prompt => 'Path to your shell?', - value => '/bin/sh', - callback => sub { -x }, - error => 'Not an executable'); - - -=cut - -sub confirm { - my ($self, %params) = @_; - my $key = delete $params{key} - or Carp::croak("No key parameter passed to confirm()"); - return $self->{__confirm__}{$key} if exists $self->{__confirm__}{$key}; - - # Create a prompt and error message, if necessary. - $params{message} = delete $params{prompt} || - "Enter a valid " . $self->key_name . " $key"; - $params{error} ||= 'Invalid value'; - - # Execute the handler sequence. - my $req = $handler->($self, "confirm", \%params); - - # Mark that we've confirmed this value. - $self->{__confirm__}{$key} = $req->value; - - return $self->{__confirm__}{$key} -} - -1; -__END__ - -=head2 Event Examples - -Below I provide some examples demonstrating the use of the event methods. -These are meant to emphasize the contexts in which it's appropriate to use -them. - -Let's start with the simplest, first. Let's say that to find the version -number for an application, you need to search a file for the relevant data. -Your App::Info concrete subclass might have a private method that handles this -work, and this method is the appropriate place to use the C<info()> and, if -necessary, C<error()> methods. - - sub _find_version { - my $self = shift; - - # Try to find the revelant file. We cover this method below. - # Just return if we cant' find it. - my $file = $self->_find_file('version.conf') or return; - - # Send a status message. - $self->info("Searching '$file' file for version"); - - # Search the file. $util is an App::Info::Util object. - my $ver = $util->search_file($file, qr/^Version\s+(.*)$/); - - # Trigger an error message, if necessary. We really think we'll have the - # value, but we have to cover our butts in the unlikely event that we're - # wrong. - $self->error("Unable to find version in file '$file'") unless $ver; - - # Return the version number. - return $ver; - } - -Here we've used the C<info()> method to display a status message to let the -user know what we're doing. Then we used the C<error()> method when something -unexpected happened, which in this case was that we weren't able to find the -version number in the file. - -Note the C<_find_file()> method we've thrown in. This might be a method that -we call whenever we need to find a file that might be in one of a list of -directories. This method, too, will be an appropriate place for an C<info()> -method call. But rather than call the C<error()> method when the file can't be -found, you might want to give an event handler a chance to supply that value -for you. Use the C<unknown()> method for a case such as this: - - sub _find_file { - my ($self, $file) = @_; - - # Send a status message. - $self->info("Searching for '$file' file"); - - # Look for the file. See App::Info:Utility for its interface. - my @paths = qw(/usr/conf /etc/conf /foo/conf); - my $found = $util->first_cat_path($file, @paths); - - # If we didn't find it, trigger an unknown event to - # give a handler a chance to get the value. - $found ||= $self->unknown( key => "file_$file", - prompt => "Location of '$file' file?", - callback => sub { -f }, - error => "Not a file"); - - # Now return the file name, regardless of whether we found it or not. - return $found; - } - -Note how in this method, we've tried to locate the file ourselves, but if we -can't find it, we trigger an unknown event. This allows clients of our -App::Info subclass to try to establish the value themselves by having an -App::Info::Handler subclass handle the event. If a value is found by an -App::Info::Handler subclass, it will be returned by C<unknown()> and we can -continue. But we can't assume that the unknown event will even be handled, and -thus must expect that an unknown value may remain unknown. This is why the -C<_find_version()> method above simply returns if C<_find_file()> doesn't -return a file name; there's no point in searching through a file that doesn't -exist. - -Attentive readers may be left to wonder how to decide when to use C<error()> -and when to use C<unknown()>. To a large extent, this decision must be based -on one's own understanding of what's most appropriate. Nevertheless, I offer -the following simple guidelines: Use C<error()> when you expect something to -work and then it just doesn't (as when a file exists and should contain the -information you seek, but then doesn't). Use C<unknown()> when you're less -sure of your processes for finding the value, and also for any of the values -that should be returned by any of the L<metadata object methods|"Metadata -Object Methods">. And of course, C<error()> would be more appropriate when you -encounter an unexpected condition and don't think that it could be handled in -any other way. - -Now, more than likely, a method such C<_find_version()> would be called by the -C<version()> method, which is a metadata method mandated by the App::Info -abstract base class. This is an appropriate place to handle an unknown version -value. Indeed, every one of your metadata methods should make use of the -C<unknown()> method. The C<version()> method then should look something like -this: - - sub version { - my $self = shift; - - unless (exists $self->{version}) { - # Try to find the version number. - $self->{version} = $self->_find_version || - $self->unknown( key => 'version', - prompt => "Enter the version number"); - } - - # Now return the version number. - return $self->{version}; - } - -Note how this method only tries to find the version number once. Any -subsequent calls to C<version()> will return the same value that was returned -the first time it was called. Of course, thanks to the C<key> parameter in the -call to C<unknown()>, we could have have tried to enumerate the version number -every time, as C<unknown()> will return the same value every time it is called -(as, indeed, should C<_find_version()>. But by checking for the C<version> key -in C<$self> ourselves, we save some of the overhead. - -But as I said before, every metadata method should make use of the -C<unknown()> method. Thus, the C<major()> method might looks something like -this: - - sub major { - my $self = shift; - - unless (exists $self->{major}) { - # Try to get the major version from the full version number. - ($self->{major}) = $self->version =~ /^(\d+)\./; - # Handle an unknown value. - $self->{major} = $self->unknown( key => 'major', - prompt => "Enter major version", - callback => sub { /^\d+$/ }, - error => "Not a number") - unless defined $self->{major}; - } - - return $self->{version}; - } - -Finally, the C<confirm()> method should be used to verify core pieces of data -that significant numbers of other methods rely on. Typically such data are -executables or configuration files from which will be drawn other metadata. -Most often, such major data points will be sought in the object constructor. -Here's an example: - - sub new { - # Construct the object so that handlers will work properly. - my $self = shift->SUPER::new(@_); - - # Try to find the executable. - $self->info("Searching for executable"); - if (my $exe = $util->first_exe('/bin/myapp', '/usr/bin/myapp')) { - # Confirm it. - $self->{exe} = - $self->confirm( key => 'binary', - prompt => 'Path to your executable?', - value => $exe, - callback => sub { -x }, - error => 'Not an executable'); - } else { - # Handle an unknown value. - $self->{exe} = - $self->unknown( key => 'binary', - prompt => 'Path to your executable?', - callback => sub { -x }, - error => 'Not an executable'); - } - - # We're done. - return $self; - } - -By now, most of what's going on here should be quite familiar. The use of the -C<confirm()> method is quite similar to that of C<unknown()>. Really the only -difference is that the value is known, but we need verification or a new value -supplied if the value we found isn't correct. Such may be the case when -multiple copies of the executable have been installed on the system, we found -F</bin/myapp>, but the user may really be interested in F</usr/bin/myapp>. -Thus the C<confirm()> event gives the user the chance to change the value if -the confirm event is handled. - -The final thing to note about this constructor is the first line: - - my $self = shift->SUPER::new(@_); - -The first thing an App::Info subclass should do is execute this line to allow -the super class to construct the object first. Doing so allows any event -handling arguments to set up the event handlers, so that when we call -C<confirm()> or C<unknown()> the event will be handled as the client expects. - -If we needed our subclass constructor to take its own parameter argumente, the -approach is to specify the same C<key => $arg> syntax as is used by -App::Info's C<new()> method. Say we wanted to allow clients of our App::Info -subclass to pass in a list of alternate executable locations for us to search. -Such an argument would most make sense as an array reference. So we specify -that the key be C<alt_paths> and allow the user to construct an object like -this: - - my $app = App::Info::Category::FooApp->new( alt_paths => \@paths ); - -This approach allows the super class constructor arguments to pass unmolested -(as long as we use unique keys!): - - my $app = App::Info::Category::FooApp->new( on_error => \@handlers, - alt_paths => \@paths ); - -Then, to retrieve these paths inside our C<new()> constructor, all we need do -is access them directly from the object: - - my $self = shift->SUPER::new(@_); - my $alt_paths = $self->{alt_paths}; - -=head2 Subclassing Guidelines - -To summarize, here are some guidelines for subclassing App::Info. - -=over 4 - -=item * - -Always subclass an App::Info category subclass. This will help to keep the -App::Info namespace well-organized. New categories can be added as needed. - -=item * - -When you create the C<new()> constructor, always call C<SUPER::new(@_)>. This -ensures that the event handling methods methods defined by the App::Info base -classes (e.g., C<error()>) will work properly. - -=item * - -Use a package-scoped lexical App::Info::Util object to carry out common tasks. -If you find you're doing something over and over that's not already addressed -by an App::Info::Util method, and you think that others might find your -solution useful, consider submitting a patch to App::Info::Util to add the -functionality you need. See L<App::Info::Util|App::Info::Util> for complete -documentation of its interface. - -=item * - -Use the C<info()> event triggering method to send messages to users of your -subclass. - -=item * - -Use the C<error()> event triggering method to alert users of unexpected -conditions. Fatal errors should still be fatal; use C<Carp::croak()> to throw -exceptions for fatal errors. - -=item * - -Use the C<unknown()> event triggering method when a metadata or other -important value is unknown and you want to give any event handlers the chance -to provide the data. - -=item * - -Use the C<confirm()> event triggering method when a core piece of data is -known (such as the location of an executable in the C<new()> constructor) and -you need to make sure that you have the I<correct> information. - -=item * - -Be sure to implement B<all> of the abstract methods defined by App::Info and -by your category abstract base class -- even if they don't do anything. Doing -so ensures that all App::Info subclasses share a common interface, and can, if -necessary, be used without regard to subclass. Any method not implemented but -called on an object will generate a fatal exception. - -=back - -Otherwise, have fun! There are a lot of software packages for which relevant -information might be collected and aggregated into an App::Info concrete -subclass (witness all of the Automake macros in the world!), and folks who are -knowledgeable about particular software packages or categories of software are -warmly invited to contribute. As more subclasses are implemented, it will make -sense, I think, to create separate distributions based on category -- or even, -when necessary, on a single software package. Broader categories can then be -aggregated in Bundle distributions. - -But I get ahead of myself... - -=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 - -The following classes define a few software package categories in which -App::Info subclasses can be placed. Check them out for ideas on how to -create new category subclasses. - -=over 4 - -=item L<App::Info::HTTP|App::Info::HTTPD> - -=item L<App::Info::RDBMS|App::Info::RDBMS> - -=item L<App::Info::Lib|App::Info::Lib> - -=back - -The following classes implement the App::Info interface for various software -packages. Check them out for examples of how to implement new App::Info -concrete subclasses. - -=over - -=item L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache> - -=item L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL> - -=item L<App::Info::Lib::Expat|App::Info::Lib::Expat> - -=item L<App::Info::Lib::Iconv|App::Info::Lib::Iconv> - -=back - -L<App::Info::Util|App::Info::Util> provides utility methods for App::Info -subclasses. - -L<App::Info::Handler|App::Info::Handler> defines an interface for event -handlers to subclass. Consult its documentation for information on creating -custom event handlers. - -The following classes implement the App::Info::Handler interface to offer some -simple event handling. Check them out for examples of how to implement new -App::Info::Handler subclasses. - -=over 4 - -=item L<App::Info::Handler::Print|App::Info::Handler::Print> - -=item L<App::Info::Handler::Carp|App::Info::Handler::Carp> - -=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> - -=back - -=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 diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm deleted file mode 100644 index 65416a8..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm +++ /dev/null @@ -1,305 +0,0 @@ -package App::Info::Handler; - -# $Id: Handler.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $ - -=head1 NAME - -App::Info::Handler - App::Info event handler base class - -=head1 SYNOPSIS - - use App::Info::Category::FooApp; - use App::Info::Handler; - - my $app = App::Info::Category::FooApp->new( on_info => ['default'] ); - -=head1 DESCRIPTION - -This class defines the interface for subclasses that wish to handle events -triggered by App::Info concrete subclasses. The different types of events -triggered by App::Info can all be handled by App::Info::Handler (indeed, by -default they're all handled by a single App::Info::Handler object), and -App::Info::Handler subclasses may be designed to handle whatever events they -wish. - -If you're interested in I<using> an App::Info event handler, this is probably -not the class you should look at, since all it does is define a simple handler -that does nothing with an event. Look to the L<App::Info::Handler -subclasses|"SEE ALSO"> included in this distribution to do more interesting -things with App::Info events. - -If, on the other hand, you're interested in implementing your own event -handlers, read on! - -=cut - -use strict; -use vars qw($VERSION); -$VERSION = '0.22'; - -my %handlers; - -=head1 INTERFACE - -This section documents the public interface of App::Info::Handler. - -=head2 Class Method - -=head3 register_handler - - App::Info::Handler->register_handler( $key => $code_ref ); - -This class method may be used by App::Info::Handler subclasses to register -themselves with App::Info::Handler. Multiple registrations are supported. The -idea is that a subclass can define different functionality by specifying -different strings that represent different modes of constructing an -App::Info::Handler subclass object. The keys are case-sensitve, and should be -unique across App::Info::Handler subclasses so that many subclasses can be -loaded and used separately. If the C<$key> is already registered, -C<register_handler()> will throw an exception. The values are code references -that, when executed, return the appropriate App::Info::Handler subclass -object. - -=cut - -sub register_handler { - my ($pkg, $key, $code) = @_; - Carp::croak("Handler '$key' already exists") - if $handlers{$key}; - $handlers{$key} = $code; -} - -# Register ourself. -__PACKAGE__->register_handler('default', sub { __PACKAGE__->new } ); - -############################################################################## - -=head2 Constructor - -=head3 new - - my $handler = App::Info::Handler->new; - $handler = App::Info::Handler->new( key => $key); - -Constructs an App::Info::Handler object and returns it. If the key parameter -is provided and has been registered by an App::Info::Handler subclass via the -C<register_handler()> class method, then the relevant code reference will be -executed and the resulting App::Info::Handler subclass object returned. This -approach provides a handy shortcut for having C<new()> behave as an abstract -factory method, returning an object of the subclass appropriate to the key -parameter. - -=cut - -sub new { - my ($pkg, %p) = @_; - my $class = ref $pkg || $pkg; - $p{key} ||= 'default'; - if ($class eq __PACKAGE__ && $p{key} ne 'default') { - # We were called directly! Handle it. - Carp::croak("No such handler '$p{key}'") unless $handlers{$p{key}}; - return $handlers{$p{key}}->(); - } else { - # A subclass called us -- just instantiate and return. - return bless \%p, $class; - } -} - -=head2 Instance Method - -=head3 handler - - $handler->handler($req); - -App::Info::Handler defines a single instance method that must be defined by -its subclasses, C<handler()>. This is the method that will be executed by an -event triggered by an App::Info concrete subclass. It takes as its single -argument an App::Info::Request object, and returns a true value if it has -handled the event request. Returning a false value declines the request, and -App::Info will then move on to the next handler in the chain. - -The C<handler()> method implemented in App::Info::Handler itself does nothing -more than return a true value. It thus acts as a very simple default event -handler. See the App::Info::Handler subclasses for more interesting handling -of events, or create your own! - -=cut - -sub handler { 1 } - -1; -__END__ - -=head1 SUBCLASSING - -I hatched the idea of the App::Info event model with its subclassable handlers -as a way of separating the aggregation of application metadata from writing a -user interface for handling certain conditions. I felt it a better idea to -allow people to create their own user interfaces, and instead to provide only -a few examples. The App::Info::Handler class defines the API interface for -handling these conditions, which App::Info refers to as "events". - -There are various types of events defined by App::Info ("info", "error", -"unknown", and "confirm"), but the App::Info::Handler interface is designed to -be flexible enough to handle any and all of them. If you're interested in -creating your own App::Info event handler, this is the place to learn how. - -=head2 The Interface - -To create an App::Info event handler, all one need do is subclass -App::Info::Handler and then implement the C<new()> constructor and the -C<handler()> method. The C<new()> constructor can do anything you like, and -take any arguments you like. However, I do recommend that the first thing -you do in your implementation is to call the super constructor: - - sub new { - my $pkg = shift; - my $self = $pkg->SUPER::new(@_); - # ... other stuff. - return $self; - } - -Although the default C<new()> constructor currently doesn't do much, that may -change in the future, so this call will keep you covered. What it does do is -take the parameterized arguments and assign them to the App::Info::Handler -object. Thus if you've specified a "mode" argument, where clients can -construct objects of you class like this: - - my $handler = FooHandler->new( mode => 'foo' ); - -You can access the mode parameter directly from the object, like so: - - sub new { - my $pkg = shift; - my $self = $pkg->SUPER::new(@_); - if ($self->{mode} eq 'foo') { - # ... - } - return $self; - } - -Just be sure not to use a parameter key name required by App::Info::Handler -itself. At the moment, the only parameter accepted by App::Info::Handler is -"key", so in general you'll be pretty safe. - -Next, I recommend that you take advantage of the C<register_handler()> method -to create some shortcuts for creating handlers of your class. For example, say -we're creating a handler subclass FooHandler. It has two modes, a default -"foo" mode and an advanced "bar" mode. To allow both to be constructed by -stringified shortcuts, the FooHandler class implementation might start like -this: - - package FooHandler; - - use strict; - use App::Info::Handler; - use vars qw(@ISA); - @ISA = qw(App::Info::Handler); - - foreach my $c (qw(foo bar)) { - App::Info::Handler->register_handler - ( $c => sub { __PACKAGE__->new( mode => $c) } ); - } - -The strings "foo" and "bar" can then be used by clients as shortcuts to have -App::Info objects automatically create and use handlers for certain events. -For example, if a client wanted to use a "bar" event handler for its info -events, it might do this: - - use App::Info::Category::FooApp; - use FooHandler; - - my $app = App::Info::Category::FooApp->new(on_info => ['bar']); - -Take a look at App::Info::Handler::Print and App::Info::Handler::Carp to see -concrete examples of C<register_handler()> usage. - -The final step in creating a new App::Info event handler is to implement the -C<handler()> method itself. This method takes a single argument, an -App::Info::Request object, and is expected to return true if it handled the -request, and false if it did not. The App::Info::Request object contains all -the metadata relevant to a request, including the type of event that triggered -it; see L<App::Info::Request|App::Info::Request> for its documentation. - -Use the App::Info::Request object however you like to handle the request -however you like. You are, however, expected to abide by a a few guidelines: - -=over 4 - -=item * - -For error and info events, you are expected (but not required) to somehow -display the info or error message for the user. How your handler chooses to do -so is up to you and the handler. - -=item * - -For unknown and confirm events, you are expected to prompt the user for a -value. If it's a confirm event, offer the known value (found in -C<$req-E<gt>value>) as a default. - -=item * - -For unknown and confirm events, you are expected to call C<$req-E<gt>callback> -and pass in the new value. If C<$req-E<gt>callback> returns a false value, you -are expected to display the error message in C<$req-E<gt>error> and prompt the -user again. Note that C<$req-E<gt>value> calls C<$req-E<gt>callback> -internally, and thus assigns the value and returns true if -C<$req-E<gt>callback> returns true, and does not assign the value and returns -false if C<$req-E<gt>callback> returns false. - -=item * - -For unknown and confirm events, if you've collected a new value and -C<$req-E<gt>callback> returns true for that value, you are expected to assign -the value by passing it to C<$req-E<gt>value>. This allows App::Info to give -the value back to the calling App::Info concrete subclass. - -=back - -Probably the easiest way to get started creating new App::Info event handlers -is to check out the simple handlers provided with the distribution and follow -their logical examples. Consult the App::Info documentation of the L<event -methods|App::Info/"Events"> for details on how App::Info constructs the -App::Info::Request object for each event type. - -=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> thoroughly documents the client interface for setting -event handlers, as well as the event triggering interface for App::Info -concrete subclasses. - -L<App::Info::Request|App::Info::Request> documents the interface for the -request objects passed to App::Info::Handler C<handler()> methods. - -The following App::Info::Handler subclasses offer examples for event handler -authors, and, of course, provide actual event handling functionality for -App::Info clients. - -=over 4 - -=item L<App::Info::Handler::Carp|App::Info::Handler::Carp> - -=item L<App::Info::Handler::Print|App::Info::Handler::Print> - -=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> - -=back - -=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 diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm deleted file mode 100644 index 47edd78..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm +++ /dev/null @@ -1,170 +0,0 @@ -package App::Info::Handler::Prompt; - -# $Id: Prompt.pm,v 1.1 2004-04-29 09:21:29 ivan Exp $ - -=head1 NAME - -App::Info::Handler::Prompt - Prompting App::Info event handler - -=head1 SYNOPSIS - - use App::Info::Category::FooApp; - use App::Info::Handler::Print; - - my $prompter = App::Info::Handler::Print->new; - my $app = App::Info::Category::FooApp->new( on_unknown => $prompter ); - - # Or... - my $app = App::Info::Category::FooApp->new( on_confirm => 'prompt' ); - -=head1 DESCRIPTION - -App::Info::Handler::Prompt objects handle App::Info events by printing their -messages to C<STDOUT> and then accepting a new value from C<STDIN>. The new -value is validated by any callback supplied by the App::Info concrete subclass -that triggered the event. If the value is valid, App::Info::Handler::Prompt -assigns the new value to the event request. If it isn't it prints the error -message associated with the event request, and then prompts for the data -again. - -Although designed with unknown and confirm events in mind, -App::Info::Handler::Prompt handles info and error events as well. It will -simply print info event messages to C<STDOUT> and print error event messages -to C<STDERR>. For more interesting info and error event handling, see -L<App::Info::Handler::Print|App::Info::Handler::Print> and -L<App::Info::Handler::Carp|App::Info::Handler::Carp>. - -Upon loading, App::Info::Handler::Print registers itself with -App::Info::Handler, setting up a single string, "prompt", that can be passed -to an App::Info concrete subclass constructor. This string is a shortcut that -tells App::Info how to create an App::Info::Handler::Print object for handling -events. - -=cut - -use strict; -use App::Info::Handler; -use vars qw($VERSION @ISA); -$VERSION = '0.22'; -@ISA = qw(App::Info::Handler); - -# Register ourselves. -App::Info::Handler->register_handler - ('prompt' => sub { __PACKAGE__->new('prompt') } ); - -=head1 INTERFACE - -=head2 Constructor - -=head3 new - - my $prompter = App::Info::Handler::Prompt->new; - -Constructs a new App::Info::Handler::Prompt object and returns it. No special -arguments are required. - -=cut - -sub new { - my $pkg = shift; - my $self = $pkg->SUPER::new(@_); - $self->{tty} = -t STDIN && ( -t STDOUT || !( -f STDOUT || -c STDOUT ) ); - # We're done! - return $self; -} - -my $get_ans = sub { - my ($prompt, $tty, $def) = @_; - # Print the message. - local $| = 1; - local $\; - print $prompt; - - # Collect the answer. - my $ans; - if ($tty) { - $ans = <STDIN>; - if (defined $ans ) { - chomp $ans; - } else { # user hit ctrl-D - print "\n"; - } - } else { - print "$def\n" if defined $def; - } - return $ans; -}; - -sub handler { - my ($self, $req) = @_; - my $ans; - my $type = $req->type; - if ($type eq 'unknown' || $type eq 'confirm') { - # We'll want to prompt for a new value. - my $val = $req->value; - my ($def, $dispdef) = defined $val ? ($val, " [$val] ") : ('', ' '); - my $msg = $req->message or Carp::croak("No message in request"); - $msg .= $dispdef; - - # Get the answer. - $ans = $get_ans->($msg, $self->{tty}, $def); - # Just return if they entered an empty string or we couldnt' get an - # answer. - return 1 unless defined $ans && $ans ne ''; - - # Validate the answer. - my $err = $req->error; - while (!$req->value($ans)) { - print "$err: '$ans'\n"; - $ans = $get_ans->($msg, $self->{tty}, $def); - return 1 unless defined $ans && $ans ne ''; - } - - } elsif ($type eq 'info') { - # Just print the message. - print STDOUT $req->message, "\n"; - } elsif ($type eq 'error') { - # Just print the message. - print STDERR $req->message, "\n"; - } else { - # This shouldn't happen. - Carp::croak("Invalid request type '$type'"); - } - - # Return true to indicate that we've handled the request. - return 1; -} - -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> documents the event handling interface. - -L<App::Info::Handler::Carp|App::Info::Handler::Carp> handles events by -passing their messages Carp module functions. - -L<App::Info::Handler::Print|App::Info::Handler::Print> handles events by -printing their messages to a file handle. - -L<App::Info::Handler|App::Info::Handler> describes how to implement custom -App::Info event handlers. - -=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 diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm deleted file mode 100644 index 504d570..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm +++ /dev/null @@ -1,55 +0,0 @@ -package App::Info::RDBMS; - -# $Id: RDBMS.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $ - -use strict; -use App::Info; -use vars qw(@ISA $VERSION); -@ISA = qw(App::Info); -$VERSION = '0.22'; - -1; -__END__ - -=head1 NAME - -App::Info::RDBMS - Information about databases on a system - -=head1 DESCRIPTION - -This class is an abstract base class for App::Info subclasses that provide -information about relational databases. Its subclasses are required to -implement its interface. See L<App::Info|App::Info> for a complete description -and L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL> for an example -implementation. - -=head1 INTERFACE - -Currently, App::Info::RDBMS adds no more methods than those from its parent -class, App::Info. - -=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<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 - - - diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm deleted file mode 100644 index aef326c..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm +++ /dev/null @@ -1,730 +0,0 @@ -package App::Info::RDBMS::PostgreSQL; - -# $Id: PostgreSQL.pm,v 1.1 2004-04-29 09:21:29 ivan Exp $ - -=head1 NAME - -App::Info::RDBMS::PostgreSQL - Information about PostgreSQL - -=head1 SYNOPSIS - - use App::Info::RDBMS::PostgreSQL; - - my $pg = App::Info::RDBMS::PostgreSQL->new; - - if ($pg->installed) { - print "App name: ", $pg->name, "\n"; - print "Version: ", $pg->version, "\n"; - print "Bin dir: ", $pg->bin_dir, "\n"; - } else { - print "PostgreSQL is not installed. :-(\n"; - } - -=head1 DESCRIPTION - -App::Info::RDBMS::PostgreSQL supplies information about the PostgreSQL -database server installed on the local system. It implements all of the -methods defined by App::Info::RDBMS. Methods that trigger events will trigger -them only the first time they're called (See L<App::Info|App::Info> for -documentation on handling events). To start over (after, say, someone has -installed PostgreSQL) construct a new App::Info::RDBMS::PostgreSQL object to -aggregate new metadata. - -Some of the methods trigger the same events. This is due to cross-calling of -shared subroutines. However, any one event should be triggered no more than -once. For example, although the info event "Executing `pg_config --version`" -is documented for the methods C<name()>, C<version()>, C<major_version()>, -C<minor_version()>, and C<patch_version()>, rest assured that it will only be -triggered once, by whichever of those four methods is called first. - -=cut - -use strict; -use App::Info::RDBMS; -use App::Info::Util; -use vars qw(@ISA $VERSION); -@ISA = qw(App::Info::RDBMS); -$VERSION = '0.22'; - -my $u = App::Info::Util->new; - -=head1 INTERFACE - -=head2 Constructor - -=head3 new - - my $pg = App::Info::RDBMS::PostgreSQL->new(@params); - -Returns an App::Info::RDBMS::PostgreSQL object. See L<App::Info|App::Info> for -a complete description of argument parameters. - -When it called, C<new()> searches the file system for the F<pg_config> -application. If found, F<pg_config> will be called by the object methods below -to gather the data necessary for each. If F<pg_config> cannot be found, then -PostgreSQL is assumed not to be installed, and each of the object methods will -return C<undef>. - -App::Info::RDBMS::PostgreSQL searches for F<pg_config> along your path, as -defined by C<File::Spec-E<gt>path>. Failing that, it searches the following -directories: - -=over 4 - -=item /usr/local/pgsql/bin - -=item /usr/local/postgres/bin - -=item /opt/pgsql/bin - -=item /usr/local/bin - -=item /usr/local/sbin - -=item /usr/bin - -=item /usr/sbin - -=item /bin - -=back - -B<Events:> - -=over 4 - -=item info - -Looking for pg_config - -=item confirm - -Path to pg_config? - -=item unknown - -Path to pg_config? - -=back - -=cut - -sub new { - # Construct the object. - my $self = shift->SUPER::new(@_); - - # Find pg_config. - $self->info("Looking for pg_config"); - my @paths = ($u->path, - qw(/usr/local/pgsql/bin - /usr/local/postgres/bin - /opt/pgsql/bin - /usr/local/bin - /usr/local/sbin - /usr/bin - /usr/sbin - /bin)); - - if (my $cfg = $u->first_cat_exe('pg_config', @paths)) { - # We found it. Confirm. - $self->{pg_config} = $self->confirm( key => 'pg_config', - prompt => 'Path to pg_config?', - value => $cfg, - callback => sub { -x }, - error => 'Not an executable'); - } else { - # Handle an unknown value. - $self->{pg_config} = $self->unknown( key => 'pg_config', - prompt => 'Path to pg_config?', - callback => sub { -x }, - error => 'Not an executable'); - } - - return $self; -} - -# We'll use this code reference as a common way of collecting data. -my $get_data = sub { - return unless $_[0]->{pg_config}; - $_[0]->info("Executing `$_[0]->{pg_config} $_[1]`"); - my $info = `$_[0]->{pg_config} $_[1]`; - chomp $info; - return $info; -}; - -############################################################################## - -=head2 Class Method - -=head3 key_name - - my $key_name = App::Info::RDBMS::PostgreSQL->key_name; - -Returns the unique key name that describes this class. The value returned is -the string "PostgreSQL". - -=cut - -sub key_name { 'PostgreSQL' } - -############################################################################## - -=head2 Object Methods - -=head3 installed - - print "PostgreSQL is ", ($pg->installed ? '' : 'not '), "installed.\n"; - -Returns true if PostgreSQL is installed, and false if it is not. -App::Info::RDBMS::PostgreSQL determines whether PostgreSQL is installed based -on the presence or absence of the F<pg_config> application on the file system -as found when C<new()> constructed the object. If PostgreSQL does not appear -to be installed, then all of the other object methods will return empty -values. - -=cut - -sub installed { return $_[0]->{pg_config} ? 1 : undef } - -############################################################################## - -=head3 name - - my $name = $pg->name; - -Returns the name of the application. App::Info::RDBMS::PostgreSQL parses the -name from the system call C<`pg_config --version`>. - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --version` - -=item error - -Failed to find PostgreSQL version with `pg_config --version` - -Unable to parse name from string - -Unable to parse version from string - -Failed to parse PostgreSQL version parts from string - -=item unknown - -Enter a valid PostgreSQL name - -=back - -=cut - -# This code reference is used by name(), version(), major_version(), -# minor_version(), and patch_version() to aggregate the data they need. -my $get_version = sub { - my $self = shift; - $self->{'--version'} = 1; - my $data = $get_data->($self, '--version'); - unless ($data) { - $self->error("Failed to find PostgreSQL version with ". - "`$self->{pg_config} --version"); - return; - } - - chomp $data; - my ($name, $version) = split /\s+/, $data, 2; - - # Check for and assign the name. - $name ? - $self->{name} = $name : - $self->error("Unable to parse name from string '$data'"); - - # Parse the version number. - if ($version) { - my ($x, $y, $z) = $version =~ /(\d+)\.(\d+).(\d+)/; - if (defined $x and defined $y and defined $z) { - @{$self}{qw(version major minor patch)} = - ($version, $x, $y, $z); - } else { - $self->error("Failed to parse PostgreSQL version parts from " . - "string '$version'"); - } - } else { - $self->error("Unable to parse version from string '$data'"); - } -}; - -sub name { - my $self = shift; - return unless $self->{pg_config}; - - # Load data. - $get_version->($self) unless $self->{'--version'}; - - # Handle an unknown name. - $self->{name} ||= $self->unknown( key => 'name' ); - - # Return the name. - return $self->{name}; -} - -############################################################################## - -=head3 version - - my $version = $pg->version; - -Returns the PostgreSQL version number. App::Info::RDBMS::PostgreSQL parses the -version number from the system call C<`pg_config --version`>. - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --version` - -=item error - -Failed to find PostgreSQL version with `pg_config --version` - -Unable to parse name from string - -Unable to parse version from string - -Failed to parse PostgreSQL version parts from string - -=item unknown - -Enter a valid PostgreSQL version number - -=back - -=cut - -sub version { - my $self = shift; - return unless $self->{pg_config}; - - # Load data. - $get_version->($self) unless $self->{'--version'}; - - # Handle an unknown value. - unless ($self->{version}) { - # Create a validation code reference. - my $chk_version = sub { - # Try to get the version number parts. - my ($x, $y, $z) = /^(\d+)\.(\d+).(\d+)$/; - # Return false if we didn't get all three. - return unless $x and defined $y and defined $z; - # Save all three parts. - @{$self}{qw(major minor patch)} = ($x, $y, $z); - # Return true. - return 1; - }; - $self->{version} = $self->unknown( key => 'version number', - callback => $chk_version); - } - - return $self->{version}; -} - -############################################################################## - -=head3 major version - - my $major_version = $pg->major_version; - -Returns the PostgreSQL major version number. App::Info::RDBMS::PostgreSQL -parses the major version number from the system call C<`pg_config --version`>. -For example, C<version()> returns "7.1.2", then this method returns "7". - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --version` - -=item error - -Failed to find PostgreSQL version with `pg_config --version` - -Unable to parse name from string - -Unable to parse version from string - -Failed to parse PostgreSQL version parts from string - -=item unknown - -Enter a valid PostgreSQL major version number - -=back - -=cut - -# This code reference is used by major_version(), minor_version(), and -# patch_version() to validate a version number entered by a user. -my $is_int = sub { /^\d+$/ }; - -sub major_version { - my $self = shift; - return unless $self->{pg_config}; - # Load data. - $get_version->($self) unless exists $self->{'--version'}; - # Handle an unknown value. - $self->{major} = $self->unknown( key => 'major version number', - callback => $is_int) - unless $self->{major}; - return $self->{major}; -} - -############################################################################## - -=head3 minor version - - my $minor_version = $pg->minor_version; - -Returns the PostgreSQL minor version number. App::Info::RDBMS::PostgreSQL -parses the minor version number from the system call C<`pg_config --version`>. -For example, if C<version()> returns "7.1.2", then this method returns "2". - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --version` - -=item error - -Failed to find PostgreSQL version with `pg_config --version` - -Unable to parse name from string - -Unable to parse version from string - -Failed to parse PostgreSQL version parts from string - -=item unknown - -Enter a valid PostgreSQL minor version number - -=back - -=cut - -sub minor_version { - my $self = shift; - return unless $self->{pg_config}; - # Load data. - $get_version->($self) unless exists $self->{'--version'}; - # Handle an unknown value. - $self->{minor} = $self->unknown( key => 'minor version number', - callback => $is_int) - unless defined $self->{minor}; - return $self->{minor}; -} - -############################################################################## - -=head3 patch version - - my $patch_version = $pg->patch_version; - -Returns the PostgreSQL patch version number. App::Info::RDBMS::PostgreSQL -parses the patch version number from the system call C<`pg_config --version`>. -For example, if C<version()> returns "7.1.2", then this method returns "1". - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --version` - -=item error - -Failed to find PostgreSQL version with `pg_config --version` - -Unable to parse name from string - -Unable to parse version from string - -Failed to parse PostgreSQL version parts from string - -=item unknown - -Enter a valid PostgreSQL minor version number - -=back - -=cut - -sub patch_version { - my $self = shift; - return unless $self->{pg_config}; - # Load data. - $get_version->($self) unless exists $self->{'--version'}; - # Handle an unknown value. - $self->{patch} = $self->unknown( key => 'patch version number', - callback => $is_int) - unless defined $self->{patch}; - return $self->{patch}; -} - -############################################################################## - -=head3 bin_dir - - my $bin_dir = $pg->bin_dir; - -Returns the PostgreSQL binary directory path. App::Info::RDBMS::PostgreSQL -gathers the path from the system call C<`pg_config --bindir`>. - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --bindir` - -=item error - -Cannot find bin directory - -=item unknown - -Enter a valid PostgreSQL bin directory - -=back - -=cut - -# This code reference is used by bin_dir(), lib_dir(), and so_lib_dir() to -# validate a directory entered by the user. -my $is_dir = sub { -d }; - -sub bin_dir { - my $self = shift; - return unless $self->{pg_config}; - unless (exists $self->{bin_dir} ) { - if (my $dir = $get_data->($self, '--bindir')) { - $self->{bin_dir} = $dir; - } else { - # Handle an unknown value. - $self->error("Cannot find bin directory"); - $self->{bin_dir} = $self->unknown( key => 'bin directory', - callback => $is_dir) - } - } - - return $self->{bin_dir}; -} - -############################################################################## - -=head3 inc_dir - - my $inc_dir = $pg->inc_dir; - -Returns the PostgreSQL include directory path. App::Info::RDBMS::PostgreSQL -gathers the path from the system call C<`pg_config --includedir`>. - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --includedir` - -=item error - -Cannot find include directory - -=item unknown - -Enter a valid PostgreSQL include directory - -=back - -=cut - -sub inc_dir { - my $self = shift; - return unless $self->{pg_config}; - unless (exists $self->{inc_dir} ) { - if (my $dir = $get_data->($self, '--includedir')) { - $self->{inc_dir} = $dir; - } else { - # Handle an unknown value. - $self->error("Cannot find include directory"); - $self->{inc_dir} = $self->unknown( key => 'include directory', - callback => $is_dir) - } - } - - return $self->{inc_dir}; -} - -############################################################################## - -=head3 lib_dir - - my $lib_dir = $pg->lib_dir; - -Returns the PostgreSQL library directory path. App::Info::RDBMS::PostgreSQL -gathers the path from the system call C<`pg_config --libdir`>. - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --libdir` - -=item error - -Cannot find library directory - -=item unknown - -Enter a valid PostgreSQL library directory - -=back - -=cut - -sub lib_dir { - my $self = shift; - return unless $self->{pg_config}; - unless (exists $self->{lib_dir} ) { - if (my $dir = $get_data->($self, '--libdir')) { - $self->{lib_dir} = $dir; - } else { - # Handle an unknown value. - $self->error("Cannot find library directory"); - $self->{lib_dir} = $self->unknown( key => 'library directory', - callback => $is_dir) - } - } - - return $self->{lib_dir}; -} - -############################################################################## - -=head3 so_lib_dir - - my $so_lib_dir = $pg->so_lib_dir; - -Returns the PostgreSQL shared object library directory path. -App::Info::RDBMS::PostgreSQL gathers the path from the system call -C<`pg_config --pkglibdir`>. - -B<Events:> - -=over 4 - -=item info - -Executing `pg_config --pkglibdir` - -=item error - -Cannot find shared object library directory - -=item unknown - -Enter a valid PostgreSQL shared object library directory - -=back - -=cut - -# Location of dynamically loadable modules. -sub so_lib_dir { - my $self = shift; - return unless $self->{pg_config}; - unless (exists $self->{so_lib_dir} ) { - if (my $dir = $get_data->($self, '--pkglibdir')) { - $self->{so_lib_dir} = $dir; - } else { - # Handle an unknown value. - $self->error("Cannot find shared object library directory"); - $self->{so_lib_dir} = - $self->unknown( key => 'shared object library directory', - callback => $is_dir) - } - } - - return $self->{so_lib_dir}; -} - -############################################################################## - -=head3 home_url - - my $home_url = $pg->home_url; - -Returns the PostgreSQL home page URL. - -=cut - -sub home_url { "http://www.postgresql.org/" } - -############################################################################## - -=head3 download_url - - my $download_url = $pg->download_url; - -Returns the PostgreSQL download URL. - -=cut - -sub download_url { "http://www.ca.postgresql.org/sitess.html" } - -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">> based on code by Sam -Tregar <L<sam@tregar.com|"sam@tregar.com">>. - -=head1 SEE ALSO - -L<App::Info|App::Info> documents the event handling interface. - -L<App::Info::RDBMS|App::Info::RDBMS> is the App::Info::RDBMS::PostgreSQL -parent class. - -L<DBD::Pg|DBD::Pg> is the L<DBI|DBI> driver for connecting to PostgreSQL -databases. - -L<http://www.postgresql.org/> is the PostgreSQL home page. - -=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 diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm deleted file mode 100644 index c02c97b..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm +++ /dev/null @@ -1,287 +0,0 @@ -package App::Info::Request; - -# $Id: Request.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $ - -=head1 NAME - -App::Info::Request - App::Info event handler request object - -=head1 SYNOPSIS - - # In an App::Info::Handler subclass: - sub handler { - my ($self, $req) = @_; - print "Event Type: ", $req->type; - print "Message: ", $req->message; - print "Error: ", $req->error; - print "Value: ", $req->value; - } - -=head1 DESCRIPTION - -Objects of this class are passed to the C<handler()> method of App::Info event -handlers. Generally, this class will be of most interest to App::Info::Handler -subclass implementers. - -The L<event triggering methods|App::Info/"Events"> in App::Info each construct -a new App::Info::Request object and initialize it with their arguments. The -App::Info::Request object is then the sole argument passed to the C<handler()> -method of any and all App::Info::Handler objects in the event handling chain. -Thus, if you'd like to create your own App::Info event handler, this is the -object you need to be familiar with. Consult the -L<App::Info::Handler|App::Info::Handler> documentation for details on creating -custom event handlers. - -Each of the App::Info event triggering methods constructs an -App::Info::Request object with different attribute values. Be sure to consult -the documentation for the L<event triggering methods|App::Info/"Events"> in -App::Info, where the values assigned to the App::Info::Request object are -documented. Then, in your event handler subclass, check the value returned by -the C<type()> method to determine what type of event request you're handling -to handle the request appropriately. - -=cut - -use strict; -use vars qw($VERSION); -$VERSION = '0.23'; - -############################################################################## - -=head1 INTERFACE - -The following sections document the App::Info::Request interface. - -=head2 Constructor - -=head3 new - - my $req = App::Info::Request->new(%params); - -This method is used internally by App::Info to construct new -App::Info::Request objects to pass to event handler objects. Generally, you -won't need to use it, other than perhaps for testing custom App::Info::Handler -classes. - -The parameters to C<new()> are passed as a hash of named parameters that -correspond to their like-named methods. The supported parameters are: - -=over 4 - -=item type - -=item message - -=item error - -=item value - -=item callback - -=back - -See the object methods documentation below for details on these object -attributes. - -=cut - -sub new { - my $pkg = shift; - - # Make sure we've got a hash of arguments. - Carp::croak("Odd number of parameters in call to " . __PACKAGE__ . - "->new() when named parameters expected" ) if @_ % 2; - my %params = @_; - - # Validate the callback. - if ($params{callback}) { - Carp::croak("Callback parameter '$params{callback}' is not a code ", - "reference") - unless UNIVERSAL::isa($params{callback}, 'CODE'); - } else { - # Otherwise just assign a default approve callback. - $params{callback} = sub { 1 }; - } - - # Validate type parameter. - if (my $t = $params{type}) { - Carp::croak("Invalid handler type '$t'") - unless $t eq 'error' or $t eq 'info' or $t eq 'unknown' - or $t eq 'confirm'; - } else { - $params{type} = 'info'; - } - - # Return the request object. - bless \%params, ref $pkg || $pkg; -} - -############################################################################## - -=head2 Object Methods - -=head3 message - - my $message = $req->message; - -Returns the message stored in the App::Info::Request object. The message is -typically informational, or an error message, or a prompt message. - -=cut - -sub message { $_[0]->{message} } - -############################################################################## - -=head3 error - - my $error = $req->error; - -Returns any error message associated with the App::Info::Request object. The -error message is typically there to display for users when C<callback()> -returns false. - -=cut - -sub error { $_[0]->{error} } - -############################################################################## - -=head3 type - - my $type = $req->type; - -Returns a string representing the type of event that triggered this request. -The types are the same as the event triggering methods defined in App::Info. -As of this writing, the supported types are: - -=over - -=item info - -=item error - -=item unknown - -=item confirm - -=back - -Be sure to consult the App::Info documentation for more details on the event -types. - -=cut - -sub type { $_[0]->{type} } - -############################################################################## - -=head3 callback - - if ($req->callback($value)) { - print "Value '$value' is valid.\n"; - } else { - print "Value '$value' is not valid.\n"; - } - -Executes the callback anonymous subroutine supplied by the App::Info concrete -base class that triggered the event. If the callback returns false, then -C<$value> is invalid. If the callback returns true, then C<$value> is valid -and can be assigned via the C<value()> method. - -Note that the C<value()> method itself calls C<callback()> if it was passed a -value to assign. See its documentation below for more information. - -=cut - -sub callback { - my $self = shift; - my $code = $self->{callback}; - local $_ = $_[0]; - $code->(@_); -} - -############################################################################## - -=head3 value - - my $value = $req->value; - if ($req->value($value)) { - print "Value '$value' successfully assigned.\n"; - } else { - print "Value '$value' not successfully assigned.\n"; - } - -When called without an argument, C<value()> simply returns the value currently -stored by the App::Info::Request object. Typically, the value is the default -value for a confirm event, or a value assigned to an unknown event. - -When passed an argument, C<value()> attempts to store the the argument as a -new value. However, C<value()> calls C<callback()> on the new value, and if -C<callback()> returns false, then C<value()> returns false and does not store -the new value. If C<callback()> returns true, on the other hand, then -C<value()> goes ahead and stores the new value and returns true. - -=cut - -sub value { - my $self = shift; - if ($#_ >= 0) { - # grab the value. - my $value = shift; - # Validate the value. - if ($self->callback($value)) { - # The value is good. Assign it and return true. - $self->{value} = $value; - return 1; - } else { - # Invalid value. Return false. - return; - } - } - # Just return the value. - return $self->{value}; -} - -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> documents the event triggering methods and how they -construct App::Info::Request objects to pass to event handlers. - -L<App::Info::Handler:|App::Info::Handler> documents how to create custom event -handlers, which must make use of the App::Info::Request object passed to their -C<handler()> object methods. - -The following classes subclass App::Info::Handler, and thus offer good -exemplars for using App::Info::Request objects when handling events. - -=over 4 - -=item L<App::Info::Handler::Carp|App::Info::Handler::Carp> - -=item L<App::Info::Handler::Print|App::Info::Handler::Print> - -=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> - -=back - -=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 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 deleted file mode 100644 index 55bb333..0000000 --- a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm +++ /dev/null @@ -1,456 +0,0 @@ -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 |