App-Info
view release on metacpan or search on metacpan
friendly versions, such as "path to httpd" instead of just
"executable". Just `tr/ /-/` to make them into command-line options.
0.44 2005-01-08T00:29:03
- Yet another fix for test failures on Win32, this time for PostgreSQL.
- Fixed SQLite tests for DBD::SQLite (which is used to collect
informationto when the SQLite executable can't be found) work
properly.
- Added workaround for strange bug on Perl 5.005_04 where handlers
assigned to an App::Info object after its creation would be
prompty forgotten. Reported by Yuval Kogman, who also gave me
a login to a server with Perl 5.005_04 to fix the problem.
0.43 2004-12-14T19:45:52
- Added "search_*_name" parameters and methods for searching for
PostgreSQL and Apache executables other than the main one,
which is already handed by "search_exe_names".
- Fixed "apache.t", "iconv.t", "postgres.t", and "sqlite3.t" tests
on Win32.
0.42 2004-12-07T00:40:53
- Fixed "NAME" section in App::Info::Request so that it has the right
name and therefore renders properly on search.cpan.org.
- Updated or added "BUGS" section of documentation in all modules to
point to the CPAN Request Tracker.
0.22 Wed Jul 3 17:31:53 2002
- Fixed tests that use Handler::Prompt so that they fake it into
always thinking there's a TTY.
0.21 Tue Jul 2 19:14:44 2002
- Fixed bug in Handler::Prompt where the prompt failed to simply
return when the user accepted the default value (with confirm
events).
- Changed email address in AUTHOR section so that it's a link.
- Added tests for confirm events.
0.20 Thu Jun 27 20:28:34 2002
- Major upgrade. Some backwards compatibility broken. Namely, the
error parameter no longer exists. See event handling instead.
- Added App::Info::Handler. Classes derived from this class handle
events triggered by App::Info subclasses.
t/errors.t
t/expat.t
t/expat_info.t
t/iconv.t
t/iconv_info.t
t/lib/EventTest.pm
t/lib/TieOut.pm
t/postgres.t
t/postgres_info.t
t/print.t
t/prompt.t
t/request.t
t/scripts/httpd
t/scripts/httpd2
t/scripts/iconv
t/scripts/myapxs
t/scripts/mycreatedb
t/scripts/myuuid
t/scripts/pg_config
t/scripts/postgres
t/scripts/sqlite3
lib/App/Info.pm view on Meta::CPAN
return @{ $self->{on_error} };
}
=head3 on_unknown
my @handlers = $app->on_unknown;
$app->on_uknown(@handlers);
Unknown events are triggered 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} };
lib/App/Info.pm view on Meta::CPAN
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} };
}
##############################################################################
lib/App/Info.pm view on Meta::CPAN
=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
lib/App/Info.pm view on Meta::CPAN
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
meta data 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 = $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};
}
lib/App/Info.pm view on Meta::CPAN
=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.
lib/App/Info.pm view on Meta::CPAN
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 = $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}
lib/App/Info.pm view on Meta::CPAN
# 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
lib/App/Info.pm view on Meta::CPAN
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
lib/App/Info.pm view on Meta::CPAN
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
lib/App/Info.pm view on Meta::CPAN
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
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
# Find Apache executable.
$self->info("Looking for Apache executable");
my @paths = $self->search_bin_dirs;
my @exes = $self->search_exe_names;
if (my $exe = $u->first_cat_exe(\@exes, @paths)) {
# We found httpd. Confirm.
$self->{executable} = $self->confirm(
key => 'path to httpd',
prompt => 'Path to your httpd executable?',
value => $exe,
callback => sub { -x },
error => 'Not an executable',
);
} else {
# Handle an unknown value.
$self->{executable} = $self->unknown(
key => 'path to httpd',
prompt => 'Path to your httpd executable?',
callback => sub { -x },
error => 'Not an executable',
);
}
return $self;
};
##############################################################################
=head2 Class Method
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
my @confs = $self->search_conf_names;
$self->{conf_file} = $u->first_cat_path(\@confs, $self->search_conf_dirs)
or $self->error("No Apache config file found");
}
}
# Handle an unknown value.
$self->{conf_file} =
$self->unknown( key => 'apache conf file',
prompt => "Location of httpd.conf file?",
callback => sub { -f },
error => "Not a file")
unless defined $self->{conf_file};
return $self->{conf_file};
}
##############################################################################
=head3 user
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
# Assign them anyway.
@{$self}{qw(user group port doc_root cgibinv cgibinp)} = ($usr, $grp, $prt, $droot, $cgibinv, $cgibinp);
};
sub user {
my $self = shift;
return unless $self->{executable};
$parse_conf_file->($self) unless exists $self->{user};
# Handle an unknown value.
$self->{user} = $self->unknown( key => 'apache user',
prompt => 'Enter Apache user name',
callback => sub { getpwnam $_ },
error => "Not a user")
unless $self->{user};
return $self->{user};
}
##############################################################################
=head3 group
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
=cut
sub group {
my $self = shift;
return unless $self->{executable};
$parse_conf_file->($self) unless exists $self->{group};
# Handle an unknown value.
$self->{group} =
$self->unknown( key => 'apache group',
prompt => 'Enter Apache user group name',
callback => sub { getgrnam $_ },
error => "Not a user group")
unless $self->{group};
return $self->{group};
}
##############################################################################
=head3 port
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
=cut
sub port {
my $self = shift;
return unless $self->{executable};
$parse_conf_file->($self) unless exists $self->{port};
# Handle an unknown value.
$self->{port} =
$self->unknown( key => 'apache port',
prompt => 'Enter Apache TCP/IP port number',
callback => $is_int,
error => "Not a valid port number")
unless $self->{port};
return $self->{port};
}
##############################################################################
=head3 doc_root
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
=cut
sub doc_root {
my $self = shift;
return unless $self->{executable};
$parse_conf_file->($self) unless exists $self->{doc_root};
# Handle an unknown value.
$self->{doc_root} = $self->unknown(
key => 'doc root',
prompt => 'Enter DocumentRoot directory',
callback => $is_dir,
error => "Not a directory"
) unless $self->{doc_root};
return $self->{doc_root};
} # doc_root
##############################################################################
=head3 cgibin_virtual
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
=cut
sub cgibin_virtual {
my $self = shift;
return unless $self->{executable};
$parse_conf_file->($self) unless exists $self->{cgibinv};
# Handle an unknown value.
$self->{cgibinv} = $self->unknown(
key => 'virtual cgi-bin',
prompt => 'Enter ScriptAlias (cgi-bin) virtual directory',
callback => $is_dir,
error => "Not a directory"
) unless $self->{cgibinv};
return $self->{cgibinv};
}
##############################################################################
=head3 cgibin_physical
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
=cut
sub cgibin_physical {
my $self = shift;
return unless $self->{executable};
$parse_conf_file->($self) unless exists $self->{cgibinp};
# Handle an unknown value.
$self->{cgibinp} = $self->unknown(
key => 'physical cgi-bin',
prompt => 'Enter ScriptAlias (cgi-bin) physical directory',
callback => $is_dir,
error => "Not a directory"
) unless $self->{cgibinp};
return $self->{cgibinp};
}
##############################################################################
=head3 executable
lib/App/Info/HTTPD/Apache.pm view on Meta::CPAN
# Find executable.
$self->info("Looking for $key");
unless ($self->{$key}) {
my $bin = $self->bin_dir or return;
if (my $exe = $u->first_cat_exe([$self->$meth(), $exe], $bin)) {
# We found it. Confirm.
$self->{$key} = $self->confirm(
key => "path to $key",
prompt => "Path to $key executable?",
value => $exe,
callback => sub { -x },
error => 'Not an executable'
);
} else {
# Handle an unknown value.
$self->{$key} = $self->unknown(
key => "path to $key",
prompt => "Path to $key executable?",
callback => sub { -x },
error => 'Not an executable'
);
}
}
return $self->{$key};
};
for my $exe (@EXES) {
lib/App/Info/Handler.pm view on Meta::CPAN
=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
lib/App/Info/Handler/Carp.pm view on Meta::CPAN
# Or...
my $app = App::Info::Category::FooApp->new( on_error => 'croak' );
=head1 DESCRIPTION
App::Info::Handler::Carp objects handle App::Info events by passing their
messages to Carp functions. This means that if you want errors to croak or
info messages to carp, you can easily do that. You'll find, however, that
App::Info::Handler::Carp is most effective for info and error events; unknown
and prompt events are better handled by event handlers that know how to prompt
users for data. See L<App::Info::Handler::Prompt|App::Info::Handler::Prompt>
for an example of that functionality.
Upon loading, App::Info::Handler::Carp registers itself with
App::Info::Handler, setting up a number of strings that can be passed to an
App::Info concrete subclass constructor. These strings are shortcuts that
tell App::Info how to create the proper App::Info::Handler::Carp object
for handling events. The registered strings are:
=over
lib/App/Info/Handler/Print.pm view on Meta::CPAN
# Or...
my $app = App::Info::Category::FooApp->new( on_error => 'stderr' );
=head1 DESCRIPTION
App::Info::Handler::Print objects handle App::Info events by printing their
messages to a filehandle. This means that if you want event messages to print
to a file or to a system filehandle, you can easily do it with this class.
You'll find, however, that App::Info::Handler::Print is most effective for
info and error events; unknown and prompt events are better handled by event
handlers that know how to prompt users for data. See
L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> for an example of
that functionality.
Upon loading, App::Info::Handler::Print registers itself with
App::Info::Handler, setting up a couple of strings that can be passed to an
App::Info concrete subclass constructor. These strings are shortcuts that
tell App::Info how to create the proper App::Info::Handler::Print object
for handling events. The registered strings are:
=over 4
lib/App/Info/Handler/Prompt.pm view on Meta::CPAN
=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.57';
@ISA = qw(App::Info::Handler);
# Register ourselves.
App::Info::Handler->register_handler
('prompt' => sub { __PACKAGE__->new } );
=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";
}
lib/App/Info/Handler/Prompt.pm view on Meta::CPAN
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 '';
lib/App/Info/Lib/Expat.pm view on Meta::CPAN
my $self = shift->SUPER::new(@_);
# Find libexpat.
$self->info("Searching for Expat libraries");
my @libs = $self->search_lib_names;
my $cb = sub { $u->first_cat_dir(\@libs, $_) };
if (my $lexpat = $u->first_cat_dir(\@libs, $self->search_lib_dirs)) {
# We found libexpat. Confirm.
$self->{libexpat} =
$self->confirm( key => 'expat lib dir',
prompt => 'Path to Expat library directory?',
value => $lexpat,
callback => $cb,
error => 'No Expat libraries found in directory');
} else {
# Handle an unknown value.
$self->{libexpat} =
$self->unknown( key => 'expat lib dir',
prompt => 'Path to Expat library directory?',
callback => $cb,
error => 'No Expat libraries found in directory');
}
return $self;
}
##############################################################################
=head2 Class Method
lib/App/Info/Lib/Iconv.pm view on Meta::CPAN
sub new {
my $self = shift->SUPER::new(@_);
# Find iconv.
$self->info("Searching for iconv");
if (my $exe = $u->first_cat_exe([$self->search_exe_names],
$self->search_bin_dirs)) {
# We found it. Confirm.
$self->{executable} = $self->confirm(
key => 'path to iconv',
prompt => 'Path to iconv executable?',
value => $exe,
callback => sub { -x },
error => 'Not an executable'
);
} else {
# No luck. Ask 'em for it.
$self->{executable} = $self->unknown(
key => 'path to iconv',
prompt => 'Path to iconv executable?',
callback => sub { -x },
error => 'Not an executable'
);
}
return $self;
}
##############################################################################
lib/App/Info/Lib/OSSPUUID.pm view on Meta::CPAN
# Find uuid-config.
$self->info("Looking for uuid-config");
my @paths = $self->search_bin_dirs;
my @exes = $self->search_exe_names;
if (my $cfg = $u->first_cat_exe(\@exes, @paths)) {
# We found it. Confirm.
$self->{uuid_config} = $self->confirm(
key => 'path to uuid-config',
prompt => "Path to uuid-config?",
value => $cfg,
callback => sub { -x },
error => 'Not an executable'
);
} else {
# Handle an unknown value.
$self->{uuid_config} = $self->unknown(
key => 'path to uuid-config',
prompt => "Path to uuid-config?",
callback => sub { -x },
error => 'Not an executable'
);
}
# Set up search defaults.
if (exists $self->{search_uuid_names}) {
$self->{search_uuid_names} = [$self->{search_uuid_names}]
unless ref $self->{search_uuid_names} eq 'ARRAY';
} else {
lib/App/Info/Lib/OSSPUUID.pm view on Meta::CPAN
# Find executable.
$self->info("Looking for $key");
unless ($self->{$key}) {
my $bin = $self->bin_dir or return;
if (my $exe = $u->first_cat_exe([$self->search_uuid_names], $bin)) {
# We found it. Confirm.
$self->{$key} = $self->confirm(
key => "path to $key",
prompt => "Path to $key executable?",
value => $exe,
callback => sub { -x },
error => 'Not an executable'
);
} else {
# Handle an unknown value.
$self->{$key} = $self->unknown(
key => "path to $key",
prompt => "Path to $key executable?",
callback => sub { -x },
error => 'Not an executable'
);
}
}
return $self->{$key};
};
*uuid = \&executable;
lib/App/Info/Lib/OSSPUUID.pm view on Meta::CPAN
=cut
sub cflags {
my $self = shift;
return unless $self->{uuid_config};
unless (exists $self->{cflags} ) {
if (my $conf = $get_data->($self, '--cflags')) {
$self->{cflags} = $conf;
} else {
# Cflags can be empty, so just make sure it exists and is
# defined. Don't prompt.
$self->{cflags} = '';
}
}
return $self->{cflags};
}
##############################################################################
=head3 ldflags
lib/App/Info/Lib/OSSPUUID.pm view on Meta::CPAN
=cut
sub ldflags {
my $self = shift;
return unless $self->{uuid_config};
unless (exists $self->{ldflags} ) {
if (my $conf = $get_data->($self, '--ldflags')) {
$self->{ldflags} = $conf;
} else {
# Ldflags can be empty, so just make sure it exists and is
# defined. Don't prompt.
$self->{ldflags} = '';
}
}
return $self->{ldflags};
}
##############################################################################
=head3 perl_module
lib/App/Info/RDBMS/PostgreSQL.pm view on Meta::CPAN
# Find pg_config.
$self->info("Looking for pg_config");
my @paths = $self->search_bin_dirs;
my @exes = $self->search_exe_names;
if (my $cfg = $u->first_cat_exe(\@exes, @paths)) {
# We found it. Confirm.
$self->{pg_config} = $self->confirm( key => 'path to 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 => 'path to pg_config',
prompt => "Path to pg_config?",
callback => sub { -x },
error => 'Not an executable');
}
# Set up search defaults.
for my $exe (@EXES) {
my $attr = "search_$exe\_names";
if (exists $self->{$attr}) {
$self->{$attr} = [$self->{$attr}] unless ref $self->{$attr} eq 'ARRAY';
} else {
lib/App/Info/RDBMS/PostgreSQL.pm view on Meta::CPAN
# Find executable.
$self->info("Looking for $key");
unless ($self->{$key}) {
my $bin = $self->bin_dir or return;
if (my $exe = $u->first_cat_exe([$self->$meth(), $exe], $bin)) {
# We found it. Confirm.
$self->{$key} = $self->confirm(
key => "path to $key",
prompt => "Path to $key executable?",
value => $exe,
callback => sub { -x },
error => 'Not an executable'
);
} else {
# Handle an unknown value.
$self->{$key} = $self->unknown(
key => "path to $key",
prompt => "Path to $key executable?",
callback => sub { -x },
error => 'Not an executable'
);
}
}
return $self->{$key};
};
for my $exe (@EXES) {
lib/App/Info/RDBMS/PostgreSQL.pm view on Meta::CPAN
=cut
sub configure {
my $self = shift;
return unless $self->{pg_config};
unless (exists $self->{configure} ) {
if (my $conf = $get_data->($self, '--configure')) {
$self->{configure} = $conf;
} else {
# Configure can be empty, so just make sure it exists and is
# defined. Don't prompt.
$self->{configure} = '';
}
}
return $self->{configure};
}
##############################################################################
=head3 home_url
lib/App/Info/RDBMS/SQLite.pm view on Meta::CPAN
my $self = shift->SUPER::new(@_);
# Find pg_config.
$self->info("Looking for SQLite");
my @exes = $self->search_exe_names;
if (my $cfg = $u->first_cat_exe(\@exes, $self->search_bin_dirs)) {
# We found it. Confirm.
$self->{executable} = $self->confirm(
key => 'path to sqlite',
prompt => "Path to SQLite executable?",
value => $cfg,
callback => sub { -x },
error => 'Not an executable'
);
} else {
$self->info("Looking for DBD::SQLite");
# Try using DBD::SQLite, which includes SQLite.
for my $dbd ('SQLite', 'SQLite2') {
eval "use DBD::$dbd";
next if $@;
lib/App/Info/RDBMS/SQLite.pm view on Meta::CPAN
require DBI;
$self->{dbfile} = $u->catfile($u->tmpdir, 'tmpdb');
$self->{dbh} = DBI->connect("dbi:$dbd:dbname=$self->{dbfile}","","");
# I don't think there's any way to really confirm, so just return.
return $self;
}
# Handle an unknown value.
$self->{executable} = $self->unknown(
key => 'path to sqlite',
prompt => "Path to SQLite executable?",
callback => sub { -x },
error => 'Not an executable'
);
}
return $self;
}
sub DESTROY {
my $self = shift;
lib/App/Info/Request.pm view on Meta::CPAN
sub key { $_[0]->{key} }
##############################################################################
=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;
t/confirm.t view on Meta::CPAN
chdir 't' if -d 't';
@INC = ('../lib', 'lib');
} else {
unshift @INC, 't/lib', 'lib';
}
}
chdir 't';
use TieOut;
##############################################################################
# Load classes and create prompt object.
BEGIN { use_ok('App::Info::HTTPD::Apache') }
BEGIN { use_ok('App::Info::RDBMS::PostgreSQL') }
BEGIN { use_ok('App::Info::Lib::Expat') }
BEGIN { use_ok('App::Info::Lib::Iconv') }
BEGIN { use_ok('App::Info::Handler::Prompt') }
ok( my $p = App::Info::Handler::Prompt->new, "Create prompt" );
$p->{tty} = 1; # Cheat death.
##############################################################################
# Tie STDOUT and STDIN so I can read them.
my $stdout = tie *STDOUT, 'TieOut' or die "Cannot tie STDOUT: $!\n";
my $stdin = tie *STDIN, 'TieOut' or die "Cannot tie STDIN: $!\n";
##############################################################################
# Test Apache.
##############################################################################
use strict;
use App::Info;
use File::Spec::Functions qw(:ALL);
use vars qw(@ISA);
@ISA = qw(App::Info);
sub key_name { 'FooApp' }
my $tmpdir = tmpdir;
sub inc_dir {
shift->unknown( key => 'bin',
prompt => 'Path to tmpdir',
callback => sub { -d $_[0] },
error => 'Not a valid directory')
}
sub lib_dir {
shift->confirm( key => 'bin',
prompt => 'Path to tmpdir',
value => $tmpdir,
callback => sub { -d $_[0] },
error => 'Not a valid directory')
}
sub patch { shift->info("Info message" ) }
sub major { shift->error("Error message" ) }
sub minor { shift->unknown( key => 'minor version number') }
sub version {
# Set up the tests.
package main;
BEGIN { use_ok('App::Info::Handler::Prompt') }
# Tie off the file handles.
my $stdout = tie *STDOUT, 'TieOut' or die "Cannot tie STDOUT: $!\n";
my $stdin = tie *STDIN, 'TieOut' or die "Cannot tie STDIN: $!\n";
my $stderr = tie *STDERR, 'TieOut' or die "Cannot tie STDERR: $!\n";
ok( my $app = App::Info::Category::FooApp->new( on_unknown => 'prompt'),
"Use keyword to set up for unknown" );
ok( my $p = App::Info::Handler::Prompt->new, "Create prompt" );
$p->{tty} = 1; # Cheat death.
ok( $app = App::Info::Category::FooApp->new( on_unknown => $p),
"Set up for unknown" );
# Make sure there were no warnings.
is $stderr->read, '', "There should be no warnings";
##############################################################################
# Set up a couple of answers.
print STDIN 'foo3424324';
print STDIN $tmpdir;
# Trigger the unknown handler.
my $dir = $app->inc_dir;
# Check the result and the output.
is( $dir, $tmpdir, "Got tmpdir from inc_dir" );
my $expected = qq{Path to tmpdir Not a valid directory: 'foo3424324'
Path to tmpdir };
is ($stdout->read, $expected, "Check unknown prompt" );
##############################################################################
# Okay, now we'll test the confirm handler.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
"Set up for first confirm" );
# Start with an affimative answer.
print STDIN "\n";
$dir = $app->lib_dir;
is($dir, $tmpdir, "Got tmpdir from lib_dir" );
$expected = qq{Path to tmpdir [$tmpdir] };
is( $stdout->read, $expected, "Check first confirm prompt" );
##############################################################################
# Now try an alternate answer.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
"Set up for second confirm" );
# Set up the answers.
print STDIN "foo123123\n";
print STDIN "$tmpdir\n";
# Set it off.
$dir = $app->lib_dir;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from second confirm" );
# Check the output.
$expected = qq{Path to tmpdir [$tmpdir] Not a valid directory: 'foo123123'
Path to tmpdir [$tmpdir] };
is( $stdout->read, $expected, "Check second confirm prompt" );
##############################################################################
# Now just try the default answer.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
"Set up for third confirm" );
# Set up the answers.
print STDIN "\n";
# Set it off.
$dir = $app->lib_dir;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from third confirm" );
# Check the output.
$expected = qq{Path to tmpdir [$tmpdir] };
is( $stdout->read, $expected, "Check third confirm prompt" );
##############################################################################
# Now test just a key argument to unknown
ok( $app = App::Info::Category::FooApp->new( on_unknown => $p),
"Set up for key argument" );
# Set up the answer.
print STDIN "$tmpdir\n";
# Set it off.
$app->minor;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from key argument" );
# Check the output.
$expected = qq{Enter a valid FooApp minor version number };
is( $stdout->read, $expected, "Check key argument prompt" );
##############################################################################
# Now test key argument with callback to unknown.
ok( $app = App::Info::Category::FooApp->new( on_unknown => $p),
"Set up for key with callback");
# Set up the answers.
print STDIN "foo\n";
print STDIN "22";
# Set it off.
my $ver = $app->version;
# Check the answer.
is($ver, 22, "Got 22 from version" );
# Check the output.
$expected = qq{Enter a valid FooApp version number Invalid value: 'foo'
Enter a valid FooApp version number };
is( $stdout->read, $expected, "Check key with callback prompt" );
##############################################################################
# Now test just a key argument to confirm
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
"Set up for key argument" );
# Set up the answer.
print STDIN "$tmpdir\n";
# Set it off.
$app->so_lib_dir;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from key argument" );
# Check the output.
$expected = qq{Enter a valid FooApp shared object directory [/foo33] };
is( $stdout->read, $expected, "Check confirm key argument prompt" );
##############################################################################
# Now test key argument with callback to confirm.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
"Set up for key with callback");
# Set up the answers.
print STDIN "foo22\n";
print STDIN "foo";
# Set it off.
$ver = $app->name;
# Check the answer.
is($ver, 'foo', "Got 'foo' from name" );
# Check the output.
$expected = qq{Enter a valid FooApp name [ick] Invalid value: 'foo22'
Enter a valid FooApp name [ick] };
is( $stdout->read, $expected, "Check confirm key with callback prompt" );
##############################################################################
# Now check how it handles info and error. These should just print to the
# relevant file handle. Info prints to STDOUT.
ok( $app = App::Info::Category::FooApp->new( on_info => $p),
"Set up for info" );
$app->patch;
is( $stdout->read, "Info message\n", "Check info message" );
# And error prints to STDERR.
( run in 1.458 second using v1.01-cache-2.11-cpan-6aa56a78535 )