freeside/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info Handler.pm,NONE,1.1.2.1 RDBMS.pm,NONE,1.1.2.1 Request.pm,NONE,1.1.2.1 Util.pm,NONE,1.1.2.1

[ivan]

Update of /home/cvs/cvsroot/freeside/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info
In directory pouncequick:/tmp/cvs-serv11497/DBD-Pg-1.22-fixvercmp/t/lib/App/Info

Added Files:
      Tag: FREESIDE_1_4_BRANCH
	Handler.pm RDBMS.pm Request.pm Util.pm 
Log Message:
adding DBD::Pg and DBIx::DBSchema for 5.005 on 1.4 branch too

--- NEW FILE: Util.pm ---
package App::Info::Util;

# $Id: Util.pm,v 1.1.2.1 2004/04/29 09:40:08 ivan Exp $

=head1 NAME

App::Info::Util - Utility class for App::Info subclasses

=head1 SYNOPSIS

  use App::Info::Util;

  my $util = App::Info::Util->new;

  # Subclasses File::Spec.
  my @paths = $util->paths;

  # First directory that exists in a list.
  my $dir = $util->first_dir(@paths);

  # First directory that exists in a path.
  $dir = $util->first_path($ENV{PATH});

  # First file that exists in a list.
  my $file = $util->first_file('this.txt', '/that.txt', 'C:\\foo.txt');

  # First file found among file base names and directories.
  my $files = ['this.txt', 'that.txt'];
  $file = $util->first_cat_file($files, @paths);

=head1 DESCRIPTION

This class subclasses L<File::Spec|File::Spec> and adds its own methods in
order to offer utility methods to L<App::Info|App::Info> classes. Although
intended to be used by App::Info subclasses, in truth App::Info::Util's
utility may be considered more general, so feel free to use it elsewhere.

The methods added in addition to the usual File::Spec suspects are designed to
facilitate locating files and directories on the file system, as well as
searching those files. The assumption is that, in order to provide useful
metadata about a given software package, an App::Info subclass must find
relevant files and directories and parse them with regular expressions. This
class offers methods that simplify those tasks.

=cut

use strict;
use File::Spec ();
use vars qw(@ISA $VERSION);
@ISA = qw(File::Spec);
$VERSION = '0.22';

my %path_dems = (MacOS   => qr',',
                 MSWin32 => qr';',
                 os2     => qr';',
                 VMS     => undef,
                 epoc    => undef);

my $path_dem = exists $path_dems{$^O} ? $path_dems{$^O} : qr':';

=head1 CONSTRUCTOR

=head2 new

  my $util = App::Info::Util->new;

This is a very simple constructor that merely returns an App::Info::Util
object. Since, like its File::Spec super class, App::Info::Util manages no
internal data itself, all methods may be used as class methods, if one prefers
to. The constructor here is provided merely as a convenience.

=cut

sub new { bless {}, ref $_[0] || $_[0] }

=head1 OBJECT METHODS

In addition to all of the methods offered by its super class,
L<File::Spec|File::Spec>, App::Info::Util offers the following methods.

=head2 first_dir

  my @paths = $util->paths;
  my $dir = $util->first_dir(@dirs);

Returns the first file system directory in @paths that exists on the local
file system. Only the first item in @paths that exists as a directory will be
returned; any other paths leading to non-directories will be ignored.

=cut

sub first_dir {
    shift;
    foreach (@_) { return $_ if -d }
    return;
}

=head2 first_path

  my $path = $ENV{PATH};
  $dir = $util->first_path($path);

Takes the $path string and splits it into a list of directory paths, based on
the path demarcator on the local file system. Then calls C<first_dir()> to
return the first directoy in the path list that exists on the local file
system. The path demarcator is specified for the following file systems:

=over 4

=item MacOS: ","

=item MSWin32: ";"

=item os2: ";"

=item VMS: undef

This method always returns undef on VMS. Patches welcome.

=item epoc: undef

This method always returns undef on epoch. Patches welcome.

=item Unix: ":"

All other operating systems are assumed to be Unix-based.

=back

=cut

sub first_path {
    return unless $path_dem;
    shift->first_dir(split /$path_dem/, shift)
}

=head2 first_file

  my $file = $util->first_file(@filelist);

Examines each of the files in @filelist and returns the first one that exists
on the file system. The file must be a regular file -- directories will be
ignored.

=cut

sub first_file {
    shift;
    foreach (@_) { return $_ if -f }
    return;
}

=head2 first_exe

  my $exe = $util->first_exe(@exelist);

Examines each of the files in @exelist and returns the first one that exists
on the file system as an executable file. Directories will be ignored.

=cut

sub first_exe {
    shift;
    foreach (@_) { return $_ if -f && -x }
    return;
}

=head2 first_cat_path

  my $file = $util->first_cat_path('ick.txt', @paths);
  $file = $util->first_cat_path(['this.txt', 'that.txt'], @paths);

The first argument to this method may be either a file or directory base name
(that is, a file or directory name without a full path specification), or a
reference to an array of file or directory base names. The remaining arguments
constitute a list of directory paths. C<first_cat_path()> processes each of
these directory paths, concatenates (by the method native to the local
operating system) each of the file or directory base names, and returns the
first one that exists on the file system.

For example, let us say that we were looking for a file called either F<httpd>
or F<apache>, and it could be in any of the following paths:
F</usr/local/bin>, F</usr/bin/>, F</bin>. The method call looks like this:

  my $httpd = $util->first_cat_path(['httpd', 'apache'], '/usr/local/bin',
                                    '/usr/bin/', '/bin');

If the OS is a Unix variant, C<first_cat_path()> will then look for the first
file that exists in this order:

=over 4

=item /usr/local/bin/httpd

=item /usr/local/bin/apache

=item /usr/bin/httpd

=item /usr/bin/apache

=item /bin/httpd

=item /bin/apache

=back

The first of these complete paths to be found will be returned. If none are
found, then undef will be returned.

=cut

sub first_cat_path {
    my $self = shift;
    my $files = ref $_[0] ? shift() : [shift()];
    foreach my $p (@_) {
        foreach my $f (@$files) {
            my $path = $self->catfile($p, $f);
            return $path if -e $path;
        }
    }
    return;
}

=head2 first_cat_dir

  my $dir = $util->first_cat_dir('ick.txt', @paths);
  $dir = $util->first_cat_dir(['this.txt', 'that.txt'], @paths);

Funtionally identical to C<first_cat_path()>, except that it returns the
directory path in which the first file was found, rather than the full
concatenated path. Thus, in the above example, if the file found was
F</usr/bin/httpd>, while C<first_cat_path()> would return that value,
C<first_cat_dir()> would return F</usr/bin> instead.

=cut

sub first_cat_dir {
    my $self = shift;
    my $files = ref $_[0] ? shift() : [shift()];
    foreach my $p (@_) {
        foreach my $f (@$files) {
            my $path = $self->catfile($p, $f);
            return $p if -e $path;
        }
    }
    return;
}

=head2 first_cat_exe

  my $exe = $util->first_cat_exe('ick.txt', @paths);
  $exe = $util->first_cat_exe(['this.txt', 'that.txt'], @paths);

Funtionally identical to C<first_cat_path()>, except that it returns the full
path to the first executable file found, rather than simply the first file
found.

=cut

sub first_cat_exe {
    my $self = shift;
    my $files = ref $_[0] ? shift() : [shift()];
    foreach my $p (@_) {
        foreach my $f (@$files) {
            my $path = $self->catfile($p, $f);
            return $path if -f $path && -x $path;
        }
    }
    return;
}

=head2 search_file

  my $file = 'foo.txt';
  my $regex = qr/(text\s+to\s+find)/;
  my $value = $util->search_file($file, $regex);

Opens C<$file> and executes the C<$regex> regular expression against each line
in the file. Once the line matches and one or more values is returned by the
match, the file is closed and the value or values returned.

For example, say F<foo.txt> contains the line "Version 6.5, patch level 8",
and you need to grab each of the three version parts. All three parts can
be grabbed like this:

  my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
  my @nums = $util->search_file($file, $regex);

Now C<@nums> will contain the values C<(6, 5, 8)>. Note that in a scalar
context, the above search would yeild an array reference:

  my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
  my $nums = $util->search_file($file, $regex);

So now C<$nums> contains C<[6, 5, 8]>. The same does not hold true if the
match returns only one value, however. Say F<foo.txt> contains the line
"king of the who?", and you wish to know who the king is king of. Either
of the following two calls would get you the data you need:

  my $minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
  my @minions = $util->search_file($file, qr/King\s+of\s+(.*)/);

In the first case, because the regular expression contains only one set of
parentheses, C<search_file()> will simply return that value: C<$minions>
contains the string "the who?". In the latter case, C<@minions> of course
contains a single element: C<("the who?")>.

Note that a regular expression without parentheses -- that is, one that
doesn't grab values and put them into $1, $2, etc., will never successfully
match a line in this method. You must include something to parentetically
match. If you just want to know the value of what was matched, parenthesize
the whole thing and if the value returns, you have a match. Also, if you need
to match patterns across lines, try using multiple regular expressions with
C<multi_search_file()>, instead.

=cut

sub search_file {
    my ($self, $file, $regex) = @_;
    return unless $file && $regex;
    open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
    my @ret;
    while (<F>) {
        # If we find a match, we're done.
        (@ret) = /$regex/ and last;
    }
    close F;
    # If the match returned an more than one value, always return the full
    # array. Otherwise, return just the first value in a scalar context.
    return unless @ret;
    return wantarray ? @ret : $#ret <= 0 ? $ret[0] : \@ret;
}

=head2 multi_search_file

  my @regexen = (qr/(one)/, qr/(two)\s+(three)/);
  my @matches = $util->multi_search_file($file, @regexen);

Like C<search_file()>, this mehod opens C<$file> and parses it for regular
expresion matches. This method, however, can take a list of regular
expressions to look for, and will return the values found for all of them.
Regular expressions that match and return multiple values will be returned as
array referernces, while those that match and return a single value will
return just that single value.

For example, say you are parsing a file with lines like the following:

  #define XML_MAJOR_VERSION 1
  #define XML_MINOR_VERSION 95
  #define XML_MICRO_VERSION 2

You need to get each of these numbers, but calling C<search_file()> for each
of them would be wasteful, as each call to C<search_file()> opens the file and
parses it. With C<multi_search_file()>, on the other hand, the file will be
opened only once, and, once all of the regular expressions have returned
matches, the file will be closed and the matches returned.

Thus the above values can be collected like this:

  my @regexen = ( qr/XML_MAJOR_VERSION\s+(\d+)$/,
                  qr/XML_MINOR_VERSION\s+(\d+)$/,
                  qr/XML_MICRO_VERSION\s+(\d+)$/ );

  my @nums = $file->multi_search_file($file, @regexen);

The result will be that C<@nums> contains C<(1, 95, 2)>. Note that
C<multi_file_search()> tries to do the right thing by only parsing the file
until all of the regular expressions have been matched. Thus, a large file
with the values you need near the top can be parsed very quickly.

As with C<search_file()>, C<multi_search_file()> can take regular expressions
that match multiple values. These will be returned as array references. For
example, say the file you're parsing has files like this:

  FooApp Version 4
  Subversion 2, Microversion 6

To get all of the version numbers, you can either use three regular
expressions, as in the previous example:

  my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
                  qr/Subversion\s+(\d+),/,
                  qr/Microversion\s+(\d$)$/ );

  my @nums = $file->multi_search_file($file, @regexen);

In which case C<@nums> will contain C<(4, 2, 6)>. Or, you can use just two
regular expressions:

  my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
                  qr/Subversion\s+(\d+),\s+Microversion\s+(\d$)$/ );

  my @nums = $file->multi_search_file($file, @regexen);

In which case C<@nums> will contain C<(4, [2, 6])>. Note that the two
parentheses that return values in the second regular expression cause the
matches to be returned as an array reference.

=cut

sub multi_search_file {
    my ($self, $file, @regexen) = @_;
    return unless $file && @regexen;
    my @each = @regexen;
    open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
    my %ret;
    while (my $line = <F>) {
        my @splice;
        # Process each of the regular expresssions.
        for (my $i = 0; $i < @each; $i++) {
            if ((my @ret) = $line =~ /$each[$i]/) {
                # We have a match! If there's one match returned, just grab
                # it. If there's more than one, keep it as an array ref.
                $ret{$each[$i]} = $#ret > 0 ? \@ret : $ret[0];
                # We got values for this regex, so not its place in the @each
                # array.
                push @splice, $i;
            }
        }
        # Remove any regexen that have already found a match.
        for (@splice) { splice @each, $_, 1 }
        # If there are no more regexes, we're done -- no need to keep
        # processing lines in the file!
        last unless @each;
    }
    close F;
    return unless %ret;
    return wantarray ? @ret{@regexen} : \@ret{@regexen};
}

1;
__END__

=head1 BUGS

Report all bugs via the CPAN Request Tracker at
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.

=head1 AUTHOR

David Wheeler <L<david at wheeler.net|"david at 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

--- NEW FILE: RDBMS.pm ---
package App::Info::RDBMS;

# $Id: RDBMS.pm,v 1.1.2.1 2004/04/29 09:40:08 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 at wheeler.net|"david at 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




--- NEW FILE: Handler.pm ---
package App::Info::Handler;

# $Id: Handler.pm,v 1.1.2.1 2004/04/29 09:40:08 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 at wheeler.net|"david at 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

--- NEW FILE: Request.pm ---
package App::Info::Request;

# $Id: Request.pm,v 1.1.2.1 2004/04/29 09:40:08 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 at wheeler.net|"david at 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