App-Info-0.57000755000765000024 011577311664 12444 5ustar00davidstaff000000000000App-Info-0.57/Build.PL000444000765000024 361611577311664 14103 0ustar00davidstaff000000000000use Module::Build; my $class = Module::Build->subclass( class => 'My::Builder', code => q{ sub ACTION_code { use File::Spec::Functions; my $self = shift; $self->SUPER::ACTION_code(@_); # Copy the test scripts and then set the shebang line and make # sure that they're executable. my $from_dir = $self->localize_file_path("t/bin"); my $to_dir = $self->localize_file_path("t/scripts"); opendir DIR, $from_dir or die "Cannot open directory '$from_dir': $!\n"; my @files = grep { !/^\./ } readdir DIR; close DIR; my @scripts; for my $bin (@files) { my $script = "$to_dir/$bin"; push @scripts, $self->localize_file_path($script); my $orig = $self->localize_file_path("t/bin/$bin"); $self->copy_if_modified( from => $orig, to_dir => $to_dir, flatten => 1, ); } $self->fix_shebang_line(@scripts); $self->make_executable(@scripts); $self->add_to_cleanup($to_dir); } }, ); my $build = $class->new( module_name => 'App::Info', license => 'perl', configure_requires => { 'Module::Build' => '0.2701' }, recommends => { 'Test::Pod' => '1.41' }, requires => { File::Spec => 0 }, build_requires => { 'Module::Build' => '0.2701', 'Test::More' => '0.17', }, meta_merge => { resources => { homepage => 'http://search.cpan.org/dist/App-Info/', bugtracker => 'http://github.com/theory/app-info/issues/', repository => 'http://github.com/theory/app-info/', } }, ); $build->create_build_script; App-Info-0.57/Changes000444000765000024 4041611577311664 14121 0ustar00davidstaff000000000000Revision history for Perl extension App::Info. 0.57 2011-06-19T06:14:46 - Removed `Makefile.PL`. It used Module::Build internally, which is deprecated. - Moved repository to [GitHub](https://github.com/theory/app-info/). - Added repository and bug reporting metadata. 0.56 2011-02-22T21:02:39 - Added `cgibin_physical()` and `cgibin_virtual()` to SVN::Notify::HTTPD::Apache. Patch from Martin Thurn. - Removed some superfluous `use Config;`s. - Added workaround for a bizarre crash when accessing `%Config` via `grep` on ActivePerl ([bug](http://bugs.activestate.com/show_bug.cgi?id=89447)). Thanks to Christian Walde for the analysis. - Fixed warning in `t/apache_info.t`. 0.55 2008-07-18T16:18:12 - Fixed some test failures on Windows boxes with PostgreSQL installed. Patch from Taro Nishino. 0.54 2008-05-18T04:01:50 - Added the doc_root() method to App::Info::HTTPD::Apache. Patch from Martin Thurn. - Added an undistributed spell-checking test, which means that the documentation has many fewer spelling errors. 0.53 2008-05-05T17:47:18 - Added the "configure_requires" and "build_requires" parameters to Build.PL. - Updated Copyright. 0.52 2007-08-13T18:24:54 - Fixed test failures on Win32 in 't/util.t.' Reported by Alex Chorny via the cpan-testers mail list. - Fixed test failure in 't/util.t' for those who happen to have an INTERCAL compiler installed. Reported by David Cantrell. 0.51 2006-09-25T17:52:53 - Really fixed the unsorted test failure by putting the sort in the right place. - The code that creates the 't/scripts' directory now runs during the 'code' action rather than the 'build' action, allowing the tests to run properly when the 'build' action has not been run. Reported By Alex Chorny (Ticket # 21281). - Fixed test failures under bleedperl where Carp was not properly loaded. Reported by Andreas Koenig (Ticket # 21641). - "OS-Dependent" skipped tests in 't/util.t' are no longer OS dependent or skipped. 0.50 2006-09-15T23:52:17 - Fixed test failures due to lack of sorting of files and directories returned by files_in_dir() on some platforms. - Fixed documentation in App::Info::HTTPD::Apache so that a line of hash symbols (#s) doesn't show up in the docs. This actually created an error in man pages. Reported by Nacho Barrientos. 0.49 2006-04-08T05:35:31 - Fixed typos in App::Info::HTTPD::Apache. - Changed keys for Apache executables such as apxs from, e.g., "apache apxs" to "path to apxs". - Added the value returned by Apache2::BuildConfig->new->{APXS_BINDIR}, if Apache2::Build config is installed, to the list of bin directories returned by search_bin_dirs() in App::Info::HTTPD::Apache. - Added "httpd2" to the list of names returned by search_exe_names() in App::Info::HTTPD::Apache. - Fixed tests in t/apache_info.t to pass on Windows. 0.48 2006-02-05T03:09:38 - Added support for Apache2 to App::Info::HTTPD::Apache. - Added files_in_dir() method to App::Info::Util to get a list of all of the files in a directory. - Added shared_mods() method to App::Info::HTTPD::Apache for getting a list of shared object libraries compiled for Apache. - The mod_perl() method of App::Info::HTTPD::Apache now also checks the shared object libraries to determine whether mod_perl is supported by the installed Apache. - Corrected some documentation pastos in App::Info::Lib::OSSPUUID. - Added perl_module() method to App::Info::Lib::OSSPUUID, since the OSSP library might be installed, but not OSSP::uuid. 0.47 2005-12-05T22:56:12 - Fixed "use lib" line in Makefile.PL caused by a bug in Module::Build. 0.46 2005-12-05T22:43:20 - Added App::Info::Lib::OSSPUUID for information about the OSSP UUID library. 0.45 2005-11-08T05:57:05 - Added "key" attribute to handler request objects. - Changed the handler key names for each subclass to more command-line 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 last Win32 test failure in "apache.t". - Added "executable()" method to return the main executable of an app or library, if there is one. - Added other executable methods to App::Info::RDBMS::PostgreSQL, including "postgres()", "createdb()", "createuser()", and others. - Added other executable methods to App::Info::HTTPD::Apache, including "ab()", "apachectl()", "apxs()", and others. - Changed behavior of App::Info::HTTPD::Apache->bin_dir to just return the name of the directory in which the httpd executable is stored, rather than a possible "bin" directory under the httpd_root. 0.41 2004-11-28T20:01:57 - Fixed Apache, SQLite, and Iconv tests to pass under Win32. - Fixed "bin_dir()" method for Apache module to return the same directory as "httpd_root()" on Win32. 0.40 2004-11-27T19:45:01 - Eliminated "Odd number of elements in hash assignment" warning when creating an App::Info::Handler::Prompt object. - Changed SQLite event messages to simply refer to "SQLite" instead of "sqlite3 or sqlite". - Added new parameters to "new()", along with accompanying accessors to collect their values: "search_exe_names", "search_bin_dirs", "search_lib_names", "search_so_lib_names", search_lib_dirs", "search_inc_names", and "search_inc_dirs". These are array references, and their values are used to search for application files on the local file system. Users can now override the directories ande files that the classes search for with their own values. Subclasses override the accessor methods to provide such values. - Updated subclases to use the new "search" methods. - Added "search_conf_names" and "search_conf_dirs" parameters and methods to App::Info::HTTPD::Apache to allow users to affect the file names paths used to search for Apache configuration files. - Added support for finding iconv on Win32. 0.30 2004-11-20T19:10:55 - Fixed number of tests to skip in "sqlite_info.t" for systems that don't have SQLite installed. Reported by numerous CPAN testers. - Fixed carp.t to be compatable with older Perls. - Added new C method to App::Info::Util to centrally handle the parsing and returning of typical library directories as defined by the "libsdirs" and "loclibpth" Config settings. - Added /sw/lib to the list of library diretories to search for SQLite libraries. - Only loading DBI in App::Info::RDBMS::SQLite if a version of DBD::SQLite is known to be installed, rather than at compile time. - Fixed tests in sqlite_info.t to work properly on Windows. 0.29 2004-11-20T00:09:22 - Added App::Info::RDBMS::SQLite to the MANIFEST so that it will actually show up in the distribution! 0.28 2004-11-19T23:35:25 - Added App::Info::RDBMS::SQLite. 0.27 2004-11-19T02:27:50 - Now using quotes when passing an executable path to `` in the Apache and PostgreSQL libraries so that they work properly when there are spaces in the path (such as on Windows). Reported by Geoff Richards. - Added "configure()" method to the PostgreSQL library. From the DBD::Pg project. - Added Windows support to the PostgreSQL module. 0.26 2004-11-03T17:53:58 - Added new path to list of paths to search for PostgreSQL. The new path, /usr/lib/postgresql/bin, is used by at least one Debian package. Submitted by Cinly Ooi. - Added support for Apache on Windows. Patch from Ron Savage. 0.25 Thu Dec 11 20:50:43 2004 - Fixed parsing of version numbers for new releases of PostgreSQL, which don't include the ".0" patch version in their version numbers. 0.24 Tue Aug 26 00:58:55 2004 - Fixed broken link in App::Info::Request documentation. - Added PostgreSQL environment variables to the paths to search for pg_config in App::Info::RDBMS::PostgreSQL. Patch from Greg Sabino Mullane. - Added handling of PostgreSQL beta version numbers to App::Info::RDBMS::PostgreSQL. Patch from Greg Sabino Mullane. - Switched to Module::Build. 0.23 Thu Aug 8 19:32:42 2002 - Fixed tests that check Apache info events so that they're more flexible about the name of the Apache executable. Thanks to Dave Rolsky for the spot. - 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. - Added event handling methods to App::Info base class. The methods are on_info(), on_error(), on_unknown(), and on_confirm(). They have constructor parameters, too, of the same names. Pass in a list of event handlers to any one of these methods to handle events of that type. - Added example event handling classes. They are App::Info::Handler::Carp, App::Info::Handler::Print, and App::Info::Handler::Prompt. Objects of these classes may be passed to any of the event handling methods listed above. - Added App::Info::Request. Objects of this class are passed to event handler objects' handler() method as the sole argument. The request object holds significant information about the request so that a handler knows what to do with a a request. - Added protected event triggering methods to App::Info. These are info(), error(), unknown(), and confirm(). If a subclass calls one of these methods, a request will be created and passed off to the list of available handlers (if any) to process the request and, in the case of unknown() and confirm(), return data to the App::Info subclass. - Refactored example subclasses to use the new event methods. Changed subclasses are App::Info::HTTPD::Apache, App::Info::RDBMS::PostgreSQL, App::Info::Lib::Expat, and App::Info::Lib::Iconv. - Wrote extensive documentation describing how to use the event methods both in App::Info subclasses and in App::Info clients. - Incremented all version numbers to 0.20. - Wrote extensive tests to test all features. 0.13 Sat Jun 8 21:17:40 2002 - Fixed Lib::Iconv so that version() would properly return undef when no include directory was found. 0.12 Sat Jun 8 20:32:38 2002 - Now more silly-proof! Fixed util.t test so that people who actually have directories named, e.g., "/foo", will still have their tests pass. Thanks to Arthur Bergman for the spot. - Fixed Lib::Expat so that version() would properly return undef when no include directory was found. Thanks to Arthur Bergman for the spot. - Fixed $VERSION in Info.pm to be available to pre-5.6.0 perls. 0.11 Sat Jun 8 05:49:40 2002 - Improved validation for the error_level parameter. - In distribution tests, no longer testing to see that user and group methods in HTTP::Apache return values when Apache is installed, as sometimes folks don't have User and Group directives set in their httpd.conf files. Grrr... - Fixed bare word references in Makefile.PL. 0.10 Wed Jun 5 23:58:54 2002 - Added new error_level parameter to new(). This tells App::Info objects how to handle errors on an object-by-object basis. The new base class method error() is for subclasses to use for throwing errors, and last_error() is for client code to access the last error in non-fatal error modes. See App::Info for complete documentation. This is the major change the triggered the (mild) version number jump. - Reworked all application subclasses to use the new error() method. - Changed all application subclasses so that they're no longer singleton classes. Each new object construction looks for application metadata all over again. - Updated documentation on subclassing to reflect changes. - Added first_exe() and first_cat_exe() to App::Info::Util. Changed RDBMS::PostgreSQL, HTTP::Apache, and Lib::Iconv to use them. - Added more directories in which to search for the Apache server executable, thanks to work by Dave Rolsky. 0.06 Wed Jun 5 15:36:36 2002 - Fixed all version tests in test scripts to check for definedness rather than truth, so that version numbers that are "0" will be ok. Thanks to Andy Lester for the spot. - Util now properly loads File::Spec rather than File::Spec::Functions. - Changed how the version number gets stored in Lib::Expat so that it only gets saved if all three version number parts are found. 0.05 Wed Jun 5 00:01:57 2002 - Eliminated possible "Use of uninitialized value in concatenation (.) or string" warning from Lib::Expat. - Eliminated possible "Use of uninitialized value in hex" warning from Lib::Iconv. - Fixed issue where RDBMS::PostgreSQL would try to execute pg_config even when it didn't exist. - Added To Do list. - Made iconv.t and expat.t tests for version numbers safer for CPAN distribution. Patches with improved methods of determining version numbers for those libraries are welcome. 0.04 Tue Jun 4 01:03:58 2002 - Wrote documentation on subclassing App::Info. - Added httpd_root() abstract method to App::Info::HTTPD abstract base class. - Added httpd_conf(), user(), group(), and port() methods to App::Info::HTTPD::Apche. - Added and corrected documentation in App::Info::HTTPD, App::Info::RDBMS, and App::Info::Lib. - Made minor documentation fixes to other classes. - Fixed methods in App::Info::Util to return undef in a scalar context if there were no regular expression matches. 0.03 Mon Jun 3 18:37:50 2002 - Private release. - Changed first_cat_file() to first_cat_path() in App::Info::Util. - Added internal tests for various subclasses. - Fixed a bunch of bugs. - Added better support for Fink-installed libraries on Darwin. 0.02 Mon Jun 3 04:38:24 2002 - Private release. - Added Expat.pm. - Many changes to Util. 0.01 Fri May 31 07:54:55 2002 - Original version. - Private release. App-Info-0.57/MANIFEST000444000765000024 247011577311664 13735 0ustar00davidstaff000000000000Build.PL Changes lib/App/Info.pm lib/App/Info/Handler.pm lib/App/Info/Handler/Carp.pm lib/App/Info/Handler/Print.pm lib/App/Info/Handler/Prompt.pm lib/App/Info/HTTPD.pm lib/App/Info/HTTPD/Apache.pm lib/App/Info/Lib.pm lib/App/Info/Lib/Expat.pm lib/App/Info/Lib/Iconv.pm lib/App/Info/Lib/OSSPUUID.pm lib/App/Info/RDBMS.pm lib/App/Info/RDBMS/PostgreSQL.pm lib/App/Info/RDBMS/SQLite.pm lib/App/Info/Request.pm lib/App/Info/Util.pm MANIFEST This list of files META.json META.yml README.md t/apache.t t/apache2.t t/apache_info.t t/bin/httpd t/bin/httpd2 t/bin/iconv t/bin/myapxs t/bin/mycreatedb t/bin/myuuid t/bin/pg_config t/bin/postgres t/bin/sqlite3 t/bin/uuid-config t/carp.t t/confirm.t 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 t/scripts/uuid-config t/sqlite.t t/sqlite_info.t t/testinc/expat.h t/testinc/iconv.h t/testinc/sqlite3.h t/testlib/httpd.conf t/testlib/libexpat.so t/testlib/libiconv.so t/testlib/libsqlite3.so t/testmod/mod_dir.so t/testmod/mod_include.so t/testmod/mod_perl.so t/testmod/not_mod.txt t/util.t t/uuid.t t/uuid_info.t t/zpod.t App-Info-0.57/META.json000444000765000024 610211577311664 14221 0ustar00davidstaff000000000000{ "abstract" : "Information about software packages on a system", "author" : [ "David E. Wheeler " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.110440", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "App-Info", "prereqs" : { "build" : { "requires" : { "Module::Build" : "0.2701", "Test::More" : "0.17" } }, "configure" : { "requires" : { "Module::Build" : "0.2701" } }, "runtime" : { "recommends" : { "Test::Pod" : "1.41" }, "requires" : { "File::Spec" : 0 } } }, "provides" : { "App::Info" : { "file" : "lib/App/Info.pm", "version" : "0.57" }, "App::Info::HTTPD" : { "file" : "lib/App/Info/HTTPD.pm", "version" : "0.57" }, "App::Info::HTTPD::Apache" : { "file" : "lib/App/Info/HTTPD/Apache.pm", "version" : "0.57" }, "App::Info::Handler" : { "file" : "lib/App/Info/Handler.pm", "version" : "0.57" }, "App::Info::Handler::Carp" : { "file" : "lib/App/Info/Handler/Carp.pm", "version" : "0.57" }, "App::Info::Handler::Print" : { "file" : "lib/App/Info/Handler/Print.pm", "version" : "0.57" }, "App::Info::Handler::Prompt" : { "file" : "lib/App/Info/Handler/Prompt.pm", "version" : "0.57" }, "App::Info::Lib" : { "file" : "lib/App/Info/Lib.pm", "version" : "0.57" }, "App::Info::Lib::Expat" : { "file" : "lib/App/Info/Lib/Expat.pm", "version" : "0.57" }, "App::Info::Lib::Iconv" : { "file" : "lib/App/Info/Lib/Iconv.pm", "version" : "0.57" }, "App::Info::Lib::OSSPUUID" : { "file" : "lib/App/Info/Lib/OSSPUUID.pm", "version" : "0.57" }, "App::Info::RDBMS" : { "file" : "lib/App/Info/RDBMS.pm", "version" : "0.57" }, "App::Info::RDBMS::PostgreSQL" : { "file" : "lib/App/Info/RDBMS/PostgreSQL.pm", "version" : "0.57" }, "App::Info::RDBMS::SQLite" : { "file" : "lib/App/Info/RDBMS/SQLite.pm", "version" : "0.57" }, "App::Info::Request" : { "file" : "lib/App/Info/Request.pm", "version" : "0.57" }, "App::Info::Util" : { "file" : "lib/App/Info/Util.pm", "version" : "0.57" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/theory/app-info/issues/" }, "homepage" : "http://search.cpan.org/dist/App-Info/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/theory/app-info/" } }, "version" : "0.57" } App-Info-0.57/META.yml000444000765000024 366611577311664 14065 0ustar00davidstaff000000000000--- abstract: 'Information about software packages on a system' author: - 'David E. Wheeler ' build_requires: Module::Build: 0.2701 Test::More: 0.17 configure_requires: Module::Build: 0.2701 dynamic_config: 1 generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110440' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: App-Info provides: App::Info: file: lib/App/Info.pm version: 0.57 App::Info::HTTPD: file: lib/App/Info/HTTPD.pm version: 0.57 App::Info::HTTPD::Apache: file: lib/App/Info/HTTPD/Apache.pm version: 0.57 App::Info::Handler: file: lib/App/Info/Handler.pm version: 0.57 App::Info::Handler::Carp: file: lib/App/Info/Handler/Carp.pm version: 0.57 App::Info::Handler::Print: file: lib/App/Info/Handler/Print.pm version: 0.57 App::Info::Handler::Prompt: file: lib/App/Info/Handler/Prompt.pm version: 0.57 App::Info::Lib: file: lib/App/Info/Lib.pm version: 0.57 App::Info::Lib::Expat: file: lib/App/Info/Lib/Expat.pm version: 0.57 App::Info::Lib::Iconv: file: lib/App/Info/Lib/Iconv.pm version: 0.57 App::Info::Lib::OSSPUUID: file: lib/App/Info/Lib/OSSPUUID.pm version: 0.57 App::Info::RDBMS: file: lib/App/Info/RDBMS.pm version: 0.57 App::Info::RDBMS::PostgreSQL: file: lib/App/Info/RDBMS/PostgreSQL.pm version: 0.57 App::Info::RDBMS::SQLite: file: lib/App/Info/RDBMS/SQLite.pm version: 0.57 App::Info::Request: file: lib/App/Info/Request.pm version: 0.57 App::Info::Util: file: lib/App/Info/Util.pm version: 0.57 recommends: Test::Pod: 1.41 requires: File::Spec: 0 resources: bugtracker: http://github.com/theory/app-info/issues/ homepage: http://search.cpan.org/dist/App-Info/ license: http://dev.perl.org/licenses/ repository: http://github.com/theory/app-info/ version: 0.57 App-Info-0.57/README.md000444000765000024 411011577311664 14054 0ustar00davidstaff000000000000App/Info version 0.57 ===================== App::Info provides a generalized interface for providing metadata about software packages installed on a system. The idea is that App::Info subclasses 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 sample App::Info and App::Info::Handler (event handling) subclasses 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 App::Info::HTTPD::Apache for an example), but are encouraged to, at a minimum, implement the methods defined by the App::Info abstract base class relevant to the category of software they're managing, e.g. App::Info::HTTPD or App::Info::RDBMS. New categories will be added as needed. Installation ------------ To install this module, type the following: perl Build.PL ./Build ./Build test ./Build install Or, if you don't have Module::Build installed, type the following: perl Makefile.PL make make test make install Dependencies ------------ This module requires these other modules and libraries: * File::Spec * Test::More -- For testing only -- part of the Test::Simple distribution. COPYRIGHT AND LICENCE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. App-Info-0.57/lib000755000765000024 011577311664 13212 5ustar00davidstaff000000000000App-Info-0.57/lib/App000755000765000024 011577311664 13732 5ustar00davidstaff000000000000App-Info-0.57/lib/App/Info.pm000444000765000024 13524611577311664 15373 0ustar00davidstaff000000000000package App::Info; =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 meta data 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 meta data 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 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 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 and L). See L 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.57'; ############################################################################## ############################################################################## # 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 attributes that can be used to help the App::Info object search for application information on the file system, as well as how the App::Info object will respond to certain events. The event parameters 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 search parameters that can be passed to C are: =over =item search_exe_names An array reference of possible names for binary executables. These may be used by subclasses to search for application programs that can be used to retrieve application information, such as version numbers. The subclasses generally provide reasonable defaults for most cases. =item search_bin_dirs An array reference of local directories in which to search for executables. These may be used to search for the value of the C attribute in addition to and in preference to the defaults used by each subclass. =item search_lib_names An array reference of possible names for library files. These may be used by subclasses to search for library files for the application. The subclasses generally provide reasonable defaults for most cases. =item search_so_lib_names An array reference of possible names for shared object library files. These may be used by subclasses to search for shared object library files for the application. The subclasses generally provide reasonable defaults for most cases. =item search_lib_dirs An array reference of local directories in which to search for libraries. These may be used to search for the value of the C and C attributes in addition to and in preference to the defaults used by each subclass. =item search_inc_names An array reference of possible names for include files. These may be used by subclasses to search for include files for the application. The subclasses generally provide reasonable defaults for most cases. =item search_inc_dirs An array reference of local directories in which to search for include files. These may be used to search for the value of the C attribute in addition to and in preference to the defaults used by each subclass. =back The parameters to C 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, 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{$_})]; } # Set up search defaults. for (qw(bin_dirs lib_dirs inc_dirs exe_names lib_names inc_names so_lib_names)) { local $_ = "search_$_"; if (exists $p{$_}) { $p{$_} = [$p{$_}] unless ref $p{$_} eq 'ARRAY'; } else { $p{$_} = []; } } # Do it! return bless \%p, $class; } ############################################################################## ############################################################################## =head2 Meta Data Object Methods These are abstract methods in App::Info and must be provided by its subclasses. They provide the essential meta data 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 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 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 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 executable my $executable = $app->executable; Returns the full path the application's bin directory, if it exists. =cut sub executable { $croak->(shift, 'executable') } ############################################################################## =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 Search Attributes These methods return lists of things to look for on the local file system when searching for application programs, library files, and include files. They are empty by default, since each subclass generally relies on its own settings, but you can add your own as preferred search parameters by specifying them as parameters to the C constructor. =head3 exe_names my @search_exe_names = $app->search_exe_names; Returns a list of possible names for an executable. Typically used by the C constructor to search for an executable to execute and collect application info. =cut sub search_exe_names { @{shift->{search_exe_names}} } ############################################################################## =head3 search_bin_dirs my @search_bin_dirs = $app->search_bin_dirs; Returns a list of possible directories in which to search an executable. Typically used by the C constructor to find an executable to execute and collect application info. The found directory will also generally then be returned by the C method. =cut sub search_bin_dirs { @{shift->{search_bin_dirs}} } ############################################################################## =head3 lib_names my @search_lib_names = $app->search_lib_names; Returns a list of possible names for library files. Typically used by the C method to find library files. =cut sub search_lib_names { @{shift->{search_lib_names}} } ############################################################################## =head3 so_lib_names my @search_so_lib_names = $app->search_so_lib_names; Returns a list of possible names for library files. Typically used by the C method to find shared object library files. =cut sub search_so_lib_names { @{shift->{search_so_lib_names}} } ############################################################################## =head3 search_lib_dirs my @search_lib_dirs = $app->search_lib_dirs; Returns a list of possible directories in which to search for libraries. Typically used by the C and C methods to find library files. =cut sub search_lib_dirs { @{shift->{search_lib_dirs}} } ############################################################################## =head3 inc_names my @search_inc_names = $app->search_inc_names; Returns a list of possible names for include files. Typically used by the C method to find include files. =cut sub search_inc_names { @{shift->{search_inc_names}} } ############################################################################## =head3 search_inc_dirs my @search_inc_dirs = $app->search_inc_dirs; Returns a list of possible directories in which to search for includes. Typically used by the C method to find include files. =cut sub search_inc_dirs { @{shift->{search_inc_dirs}} } ############################################################################## ############################################################################## =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 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 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 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 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 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 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 meta data 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 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 in order to offer easy access to commonly-used methods from that class, e.g., C. 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 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 cannot 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 request. 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 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 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. The parameters are as follows: =over 4 =item key The C 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 as was returned by the first call, and no handlers will be activated. Typical values are "version" and "lib_dir". =item prompt The C 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 method and the C parameter. The result would be something like "Enter a valid FooApp version". The C parameter value will be stored in the C 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 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. The C parameter code reference will be stored in the C 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 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 identified as invalid, a message to display might be something like "Invalid directory path". Note that if the C parameter is not provided, App::Info will supply the generic error message "Invalid value". This value will be stored in the C 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 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}; } ############################################################################## =head3 confirm my $val = $self->confirm(@params); This method is very similar to C, 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 meta data 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 meta data 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, its use is quite similar to that of C. Its parameters are as follows: =over =item key Same as for C, 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 as was returned by the first call for a given key. =item prompt Same as for C. Although C is called to confirm a value, typically the prompt should request the relevant value, just as for C. The difference is that the handler I use the C parameter as the default should the user not provide a value. The C parameter will be stored in the C 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 attribute of the App::Info::Request object passed to event handlers. =item callback Same as for C. Because the user can enter data to replace the default value provided via the C parameter, you might want to validate it. Use this code reference to do so. The callback will be stored in the C attribute of the App::Info::Request object passed to event handlers. =item error Same as for C: an error message to display in the event that a value entered by the user isn't validated by the C code reference. This value will be stored in the C 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} } 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 and, if necessary, C 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 method to display a status message to let the user know what we're doing. Then we used the C 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 method call. But rather than call the C 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 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 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 and when to use C. 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 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 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. And of course, C 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 method, which is a meta data 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 meta data methods should make use of the C method. The C 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 will return the same value that was returned the first time it was called. Of course, thanks to the C parameter in the call to C, we could have have tried to enumerate the version number every time, as C will return the same value every time it is called (as, indeed, should C<_find_version()>. But by checking for the C key in C<$self> ourselves, we save some of the overhead. But as I said before, every meta data method should make use of the C method. Thus, the C 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 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 meta data. 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 method is quite similar to that of C. 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, but the user may really be interested in F. Thus the C 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 or C the event will be handled as the client expects. If we needed our subclass constructor to take its own parameter argument, the approach is to specify the same C $arg> syntax as is used by App::Info's C 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 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 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 name space well-organized. New categories can be added as needed. =item * When you create the C constructor, always call C. This ensures that the event handling methods methods defined by the App::Info base classes (e.g., C) 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 for complete documentation of its interface. =item * Use the C event triggering method to send messages to users of your subclass. =item * Use the C event triggering method to alert users of unexpected conditions. Fatal errors should still be fatal; use C to throw exceptions for fatal errors. =item * Use the C event triggering method when a meta data or other important value is unknown and you want to give any event handlers the chance to provide the data. =item * Use the C event triggering method when a core piece of data is known (such as the location of an executable in the C constructor) and you need to make sure that you have the I information. =item * Be sure to implement B 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 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =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 =item L =item L =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 =item L =item L =item L =back L provides utility methods for App::Info subclasses. L 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 =item L =item L =back =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info000755000765000024 011577311664 14625 5ustar00davidstaff000000000000App-Info-0.57/lib/App/Info/Handler.pm000444000765000024 2515311577311664 16723 0ustar00davidstaff000000000000package App::Info::Handler; =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 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 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.57'; 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-sensitive, 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 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 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 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. 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 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 meta data 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 constructor and the C method. The C 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 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 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 usage. The final step in creating a new App::Info event handler is to implement the C 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 meta data relevant to a request, including the type of event that triggered it; see L 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-Evalue>) as a default. =item * For unknown and confirm events, you are expected to call C<$req-Ecallback> and pass in the new value. If C<$req-Ecallback> returns a false value, you are expected to display the error message in C<$req-Eerror> and prompt the user again. Note that C<$req-Evalue> calls C<$req-Ecallback> internally, and thus assigns the value and returns true if C<$req-Ecallback> returns true, and does not assign the value and returns false if C<$req-Ecallback> returns false. =item * For unknown and confirm events, if you've collected a new value and C<$req-Ecallback> returns true for that value, you are expected to assign the value by passing it to C<$req-Evalue>. 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 for details on how App::Info constructs the App::Info::Request object for each event type. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L thoroughly documents the client interface for setting event handlers, as well as the event triggering interface for App::Info concrete subclasses. L documents the interface for the request objects passed to App::Info::Handler C 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 =item L =item L =back =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/HTTPD.pm000444000765000024 404611577311664 16207 0ustar00davidstaff000000000000package App::Info::HTTPD; use strict; use App::Info; use vars qw(@ISA $VERSION); @ISA = qw(App::Info); $VERSION = '0.57'; my $croak = sub { my ($caller, $meth) = @_; $caller = ref $caller || $caller; if ($caller eq __PACKAGE__) { $meth = __PACKAGE__ . '::' . shift; 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"); } }; sub httpd_root { $croak->(shift, 'httpd_root') } 1; __END__ =head1 NAME App::Info::HTTPD - Information about web servers on a system =head1 DESCRIPTION This subclass of App::Info is an abstract base class for subclasses that provide information about web servers. Its subclasses are required to implement its interface. See L for a complete description and L for an example implementation. =head1 INTERFACE In addition to the methods outlined by its App::Info parent class, App::Info::HTTPD offers the following abstract methods =head1 OBJECT METHODS =head2 httpd_root my $httpd_root = $app->httpd_root; The root directory of the HTTPD server. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L, L =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Lib.pm000444000765000024 254211577311664 16031 0ustar00davidstaff000000000000package App::Info::Lib; use strict; use App::Info; use vars qw(@ISA $VERSION); @ISA = qw(App::Info); $VERSION = '0.57'; 1; __END__ =head1 NAME App::Info::Lib - Information about software libraries on a system =head1 DESCRIPTION This class is an abstract base class for App::Info subclasses that provide information about specific software libraries. Its subclasses are required to implement its interface. See L for a complete description, and L for an example implementation. =head1 INTERFACE Currently, App::Info::Lib adds no more methods than those from its parent class, App::Info. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L, L, L =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/RDBMS.pm000444000765000024 250511577311664 16171 0ustar00davidstaff000000000000package App::Info::RDBMS; use strict; use App::Info; use vars qw(@ISA $VERSION); @ISA = qw(App::Info); $VERSION = '0.57'; 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 for a complete description and L for an example implementation. =head1 INTERFACE Currently, App::Info::RDBMS adds no more methods than those from its parent class, App::Info. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L, L =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Request.pm000444000765000024 2026611577311664 16776 0ustar00davidstaff000000000000package App::Info::Request; =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 method of App::Info event handlers. Generally, this class will be of most interest to App::Info::Handler subclass implementers. The L 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 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 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 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 method to determine what type of event request you're handling to handle the request appropriately. =cut use strict; use vars qw($VERSION); use Carp; $VERSION = '0.57'; ############################################################################## =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 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 key my $key = $req->key; Returns the key stored in the App::Info::Request object. The key is used by the App::Info subclass to uniquely identify the information it is harvesting, such as the path to an executable. It might be used by request handlers, for example, to see if an option was passed on the command-line. =cut 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; Returns any error message associated with the App::Info::Request object. The error message is typically there to display for users when C 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 method. Note that the C method itself calls C 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 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 attempts to store the the argument as a new value. However, C calls C on the new value, and if C returns false, then C returns false and does not store the new value. If C returns true, on the other hand, then C 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 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L documents the event triggering methods and how they construct App::Info::Request objects to pass to event handlers. L documents how to create custom event handlers, which must make use of the App::Info::Request object passed to their C 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 =item L =item L =back =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Util.pm000444000765000024 4012211577311664 16254 0ustar00davidstaff000000000000package App::Info::Util; =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 and adds its own methods in order to offer utility methods to L 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 meta data 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 Config; use vars qw(@ISA $VERSION); @ISA = qw(File::Spec); $VERSION = '0.57'; 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, 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 delimiter on the local file system. Then calls C to return the first directory in the path list that exists on the local file system. The path delimiter 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 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 or F, and it could be in any of the following paths: F, F, F. 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 will then look for the first file that exists in this order: =over 4 =item /usr/local/bin/httpd =item /usr/local/bin/apache =item /usr/bin/httpd =item /usr/bin/apache =item /bin/httpd =item /bin/apache =back The first of these complete paths to be found will be returned. If none are found, then undef will be returned. =cut sub first_cat_path { my $self = shift; my $files = ref $_[0] ? shift() : [shift()]; foreach my $p (@_) { foreach my $f (@$files) { my $path = $self->catfile($p, $f); return $path if -e $path; } } return; } ############################################################################## =head2 first_cat_dir my $dir = $util->first_cat_dir('ick.txt', @paths); $dir = $util->first_cat_dir(['this.txt', 'that.txt'], @paths); Functionally identical to C, 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, while C would return that value, C would return F instead. =cut sub first_cat_dir { my $self = shift; my $files = ref $_[0] ? shift() : [shift()]; foreach my $p (@_) { foreach my $f (@$files) { my $path = $self->catfile($p, $f); return $p if -e $path; } } return; } ############################################################################## =head2 first_cat_exe my $exe = $util->first_cat_exe('ick.exe', @paths); $exe = $util->first_cat_exe(['this.exe', 'that.exe'], @paths); Functionally identical to C, 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 contains the line "Version 6.5, patch level 8", and you need to grab each of the three version parts. All three parts can be grabbed like this: my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/; my @nums = $util->search_file($file, $regex); Now C<@nums> will contain the values C<(6, 5, 8)>. Note that in a scalar context, the above search would yield an array reference: my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/; my $nums = $util->search_file($file, $regex); So now C<$nums> contains C<[6, 5, 8]>. The same does not hold true if the match returns only one value, however. Say F 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 will simply return that value: C<$minions> contains the string "the who?". In the latter case, C<@minions> of course contains a single element: C<("the who?")>. Note that a regular expression without parentheses -- that is, one that doesn't grab values and put them into $1, $2, etc., will never successfully match a line in this method. You must include something to parenthetically match. If you just want to know the value of what was matched, parenthesize the whole thing and if the value returns, you have a match. Also, if you need to match patterns across lines, try using multiple regular expressions with C, instead. =cut sub search_file { my ($self, $file, $regex) = @_; return unless $file && $regex; open F, "<$file" or require Carp && Carp::croak("Cannot open $file: $!\n"); my @ret; while () { # If we find a match, we're done. (@ret) = /$regex/ and last; } close F; # If the match returned an more than one value, always return the full # array. Otherwise, return just the first value in a scalar context. return unless @ret; return wantarray ? @ret : $#ret <= 0 ? $ret[0] : \@ret; } ############################################################################## =head2 files_in_dir my @files = $util->files_in_dir($dir); @files = $util->files_in_dir($dir, $filter); my $files = $util->files_in_dir($dir); $files = $util->files_in_dir($dir, $filter); Returns an list or array reference of all of the files and directories in the file system directory C<$dir>. An optional second argument is a code reference that filters the files. The code reference should examine the C<$_> for a file name and return true if it's a file that you're interested and false if it's not. =cut sub files_in_dir { my ($self, $dir, $code) = @_; return unless $dir; local *DIR; opendir DIR, $dir or require Carp && Carp::croak("Cannot open $dir: $!\n"); my @files = $code ? grep { $code->() } readdir DIR : readdir DIR; closedir DIR; return wantarray ? @files : \@files; } ############################################################################## =head2 multi_search_file my @regexen = (qr/(one)/, qr/(two)\s+(three)/); my @matches = $util->multi_search_file($file, @regexen); Like C, this method opens C<$file> and parses it for regular expression matches. This method, however, can take a list of regular expressions to look for, and will return the values found for all of them. Regular expressions that match and return multiple values will be returned as array references, while those that match and return a single value will return just that single value. For example, say you are parsing a file with lines like the following: #define XML_MAJOR_VERSION 1 #define XML_MINOR_VERSION 95 #define XML_MICRO_VERSION 2 You need to get each of these numbers, but calling C for each of them would be wasteful, as each call to C opens the file and parses it. With C, 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 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, C can take regular expressions that match multiple values. These will be returned as array references. For example, say the file you're parsing has files like this: FooApp Version 4 Subversion 2, Microversion 6 To get all of the version numbers, you can either use three regular expressions, as in the previous example: my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/, qr/Subversion\s+(\d+),/, qr/Microversion\s+(\d$)$/ ); my @nums = $file->multi_search_file($file, @regexen); In which case C<@nums> will contain C<(4, 2, 6)>. Or, you can use just two regular expressions: my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/, qr/Subversion\s+(\d+),\s+Microversion\s+(\d$)$/ ); my @nums = $file->multi_search_file($file, @regexen); In which case C<@nums> will contain C<(4, [2, 6])>. Note that the two parentheses that return values in the second regular expression cause the matches to be returned as an array reference. =cut sub multi_search_file { my ($self, $file, @regexen) = @_; return unless $file && @regexen; my @each = @regexen; open F, "<$file" or require Carp && Carp::croak("Cannot open $file: $!\n"); my %ret; while (my $line = ) { my @splice; # Process each of the regular expresssions. for (my $i = 0; $i < @each; $i++) { if ((my @ret) = $line =~ /$each[$i]/) { # We have a match! If there's one match returned, just grab # it. If there's more than one, keep it as an array ref. $ret{$each[$i]} = $#ret > 0 ? \@ret : $ret[0]; # We got values for this regex, so not its place in the @each # array. push @splice, $i; } } # Remove any regexen that have already found a match. for (@splice) { splice @each, $_, 1 } # If there are no more regexes, we're done -- no need to keep # processing lines in the file! last unless @each; } close F; return unless %ret; return wantarray ? @ret{@regexen} : \@ret{@regexen}; } ############################################################################## =head2 lib_dirs my @dirs = $util->lib_dirs; Returns a list of possible library directories to be searched. These are gathered from the C and C Config settings. These are useful for passing to C to search typical directories for library files. =cut sub lib_dirs { grep { defined and length } map { split ' ' } grep { defined } # Quote Config access to work around # http://bugs.activestate.com/show_bug.cgi?id=89447 "$Config{libsdirs}", "$Config{loclibpth}", '/sw/lib'; } 1; __END__ =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L, L, L L =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Handler000755000765000024 011577311664 16202 5ustar00davidstaff000000000000App-Info-0.57/lib/App/Info/Handler/Carp.pm000444000765000024 1152611577311664 17607 0ustar00davidstaff000000000000package App::Info::Handler::Carp; =head1 NAME App::Info::Handler::Carp - Use Carp to handle App::Info events =head1 SYNOPSIS use App::Info::Category::FooApp; use App::Info::Handler::Carp; my $carp = App::Info::Handler::Carp->new('carp'); my $app = App::Info::Category::FooApp->new( on_info => $carp ); # 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 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 =item carp Passes the event message to C. =item warn An alias for "carp". =item croak Passes the event message to C. =item die An alias for "croak". =item cluck Passes the event message to C. =item confess Passes the event message to C. =back =cut use strict; use App::Info::Handler; use vars qw($VERSION @ISA); $VERSION = '0.57'; @ISA = qw(App::Info::Handler); my %levels = ( croak => sub { goto &Carp::croak }, carp => sub { goto &Carp::carp }, cluck => sub { goto &Carp::cluck }, confess => sub { goto &Carp::confess } ); # A couple of aliases. $levels{die} = $levels{croak}; $levels{warn} = $levels{carp}; # Register ourselves. for my $c (qw(croak carp cluck confess die warn)) { App::Info::Handler->register_handler ($c => sub { __PACKAGE__->new( level => $c ) } ); } =head1 INTERFACE =head2 Constructor =head3 new my $carp_handler = App::Info::Handler::Carp->new; $carp_handler = App::Info::Handler::Carp->new( level => 'carp' ); my $croak_handler = App::Info::Handler::Carp->new( level => 'croak' ); Constructs a new App::Info::Handler::Carp object and returns it. It can take a single parameterized argument, C, which can be any one of the following values: =over =item carp Constructs a App::Info::Handler::Carp object that passes the event message to C. =item warn An alias for "carp". =item croak Constructs a App::Info::Handler::Carp object that passes the event message to C. =item die An alias for "croak". =item cluck Constructs a App::Info::Handler::Carp object that passes the event message to C. =item confess Constructs a App::Info::Handler::Carp object that passes the event message to C. =back If the C parameter is not passed, C will default to creating an App::Info::Handler::Carp object that passes App::Info event messages to C. =cut sub new { my $pkg = shift; my $self = $pkg->SUPER::new(@_); if ($self->{level}) { Carp::croak("Invalid error handler '$self->{level}'") unless $levels{$self->{level}}; } else { $self->{level} = 'carp'; } return $self; } sub handler { my ($self, $req) = @_; # Change package to App::Info to trick Carp into issuing the stack trace # from the proper context of the caller. package App::Info; $levels{$self->{level}}->($req->message); # Return true to indicate that we've handled the request. return 1; } 1; __END__ =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L documents the event handling interface. L of documents the functions used by this class. L handles events by printing their messages to a file handle. L offers event handling more appropriate for unknown and confirm events. L describes how to implement custom App::Info event handlers. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Handler/Print.pm000444000765000024 1142711577311664 20016 0ustar00davidstaff000000000000package App::Info::Handler::Print; =head1 NAME App::Info::Handler::Print - Print App::Info event messages =head1 SYNOPSIS use App::Info::Category::FooApp; use App::Info::Handler::Print; my $stdout = App::Info::Handler::Print->new( fh => 'stdout' ); my $app = App::Info::Category::FooApp->new( on_info => $stdout ); # 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 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 =item stdout Prints event messages to C. =item stderr Prints event messages to C. =back See the C constructor below for how to have App::Info::Handler::Print print event messages to different filehandle. =cut use strict; use App::Info::Handler; use vars qw($VERSION @ISA); $VERSION = '0.57'; @ISA = qw(App::Info::Handler); # Register ourselves. for my $c (qw(stderr stdout)) { App::Info::Handler->register_handler ($c => sub { __PACKAGE__->new( fh => $c ) } ); } =head1 INTERFACE =head2 Constructor =head3 new my $stderr_handler = App::Info::Handler::Print->new; $stderr_handler = App::Info::Handler::Print->new( fh => 'stderr' ); my $stdout_handler = App::Info::Handler::Print->new( fh => 'stdout' ); my $fh = FileHandle->new($file); my $fh_handler = App::Info::Handler::Print->new( fh => $fh ); Constructs a new App::Info::Handler::Print and returns it. It can take a single parameterized argument, C, which can be any one of the following values: =over 4 =item stderr Constructs a App::Info::Handler::Print object that prints App::Info event messages to C. =item stdout Constructs a App::Info::Handler::Print object that prints App::Info event messages to C. =item FileHandle =item GLOB Pass in a reference and App::Info::Handler::Print will assume that it's a filehandle reference that it can print to. Note that passing in something that can't be printed to will trigger an exception when App::Info::Handler::Print tries to print to it. =back If the C parameter is not passed, C will default to creating an App::Info::Handler::Print object that prints App::Info event messages to C. =cut sub new { my $pkg = shift; my $self = $pkg->SUPER::new(@_); if (!defined $self->{fh} || $self->{fh} eq 'stderr') { # Create a reference to STDERR. $self->{fh} = \*STDERR; } elsif ($self->{fh} eq 'stdout') { # Create a reference to STDOUT. $self->{fh} = \*STDOUT; } elsif (!ref $self->{fh}) { # Assume a reference to a filehandle or else it's invalid. Carp::croak("Invalid argument to new(): '$self->{fh}'"); } # We're done! return $self; } ############################################################################## =head3 handler This method is called by App::Info to print out the message from events. =cut sub handler { my ($self, $req) = @_; print {$self->{fh}} $req->message, "\n"; # Return true to indicate that we've handled the request. return 1; } 1; __END__ =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L documents the event handling interface. L handles events by passing their messages Carp module functions. L offers event handling more appropriate for unknown and confirm events. L describes how to implement custom App::Info event handlers. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Handler/Prompt.pm000444000765000024 1145111577311664 20200 0ustar00davidstaff000000000000package App::Info::Handler::Prompt; =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 and then accepting a new value from C. 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 and print error event messages to C. For more interesting info and error event handling, see L and L. 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 = ; 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 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L documents the event handling interface. L handles events by passing their messages Carp module functions. L handles events by printing their messages to a file handle. L describes how to implement custom App::Info event handlers. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/HTTPD000755000765000024 011577311664 15510 5ustar00davidstaff000000000000App-Info-0.57/lib/App/Info/HTTPD/Apache.pm000444000765000024 12726411577311664 17440 0ustar00davidstaff000000000000package App::Info::HTTPD::Apache; =head1 NAME App::Info::HTTPD::Apache - Information about Apache web server =head1 SYNOPSIS use App::Info::HTTPD::Apache; my $apache = App::Info::HTTPD::Apache->new; if ($apache->installed) { print "App name: ", $apache->name, "\n"; print "Version: ", $apache->version, "\n"; print "Bin dir: ", $apache->bin_dir, "\n"; } else { print "Apache is not installed. :-(\n"; } =head1 DESCRIPTION App::Info::HTTPD::Apache supplies information about the Apache web server installed on the local system. It implements all of the methods defined by App::Info::HTTPD. Methods that trigger events will trigger them only the first time they're called (See L for documentation on handling events). To start over (after, say, someone has installed Apache) construct a new App::Info::HTTPD::Apache object to aggregate new meta data. Some of the methods trigger the same events. This is due to cross-calling of methods or of functions common to methods. However, any one event should be triggered no more than once. For example, although the info event "Executing `httpd -v`" is documented for the methods C, C, C, C, and C, rest assured that it will only be triggered once, by whichever of those four methods is called first. =cut use strict; use App::Info::HTTPD; use App::Info::Util; use vars qw(@ISA $VERSION); @ISA = qw(App::Info::HTTPD); $VERSION = '0.57'; use constant WIN32 => $^O eq 'MSWin32'; my $u = App::Info::Util->new; my @EXES = qw(ab apachectl apxs htdigest htpasswd logresolve rotatelogs); =head1 INTERFACE =head2 Constructor =head3 new my $apache = App::Info::HTTPD::Apache->new(@params); Returns an App::Info::HTTPD::Apache object. See L for a complete description of argument parameters. When called, C searches the the directories returned by C for an executable with a name returned by C. If found, the executable (hereafter referred to as F, regardless of how it was actually found to be named) will be called by the object methods below to gather the data necessary for each. If F cannot be found, then Apache is assumed not to be installed, and each of the object methods will return C. In addition to the parameters supported by the parent classes, L and L, this class' C method also supports: =over 4 =item search_conf_names An array reference of possible names for Apache configuration files. These will be returned by the C method before the default names, and may be used by C to search for the configuration file. =item search_conf_dirs An array reference of possible directories in which to search for Apache configuration files. These will be returned by the C method before the default directories, and may be used by C to search for the configuration file. =back As well as these parameters to specify alternate names for Apache executables (other than F, which you specify via the C parameter): =over =item search_ab_names =item search_apachectl_names =item search_apxs_names =item search_htdigest_names =item search_htpasswd_names =item search_logresolve_names =item search_rotatelogs_names =back B =over 4 =item info Looking for Apache executable =item confirm Path to your httpd executable? =item unknown Path to your httpd executable? =back =cut sub new { # Construct the object. my $self = shift->SUPER::new(@_); for my $exe (qw(search_conf_dirs search_conf_names), map { "search_$_\_names" } @EXES ) { if (exists $self->{$exe}) { $self->{$exe} = [$self->{$exe}] unless ref $self->{$exe} eq 'ARRAY'; } else { $self->{$exe} = []; } } # 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 =head3 key_name my $key_name = App::Info::HTTPD::Apache->key_name; Returns the unique key name that describes this class. The value returned is the string "Apache". =cut sub key_name { 'Apache' } ############################################################################## =head2 Object Methods =head3 installed print "apache is ", ($apache->installed ? '' : 'not '), "installed.\n"; Returns true if Apache is installed, and false if it is not. App::Info::HTTPD::Apache determines whether Apache is installed based on the presence or absence of the F application on the file system, as found when C constructed the object. If Apache does not appear to be installed, then all of the other object methods will return empty values. =cut sub installed { return $_[0]->{executable} ? 1 : undef } ############################################################################## =head3 name my $name = $apache->name; Returns the name of the application. App::Info::HTTPD::Apache parses the name from the system call C<`httpd -v`>. B =over 4 =item info Executing `httpd -v` =item error Failed to find Apache version data with `httpd -v` Failed to parse Apache name and version from string =item unknown Enter a valid Apache name =back =cut my $get_version = sub { my $self = shift; $self->{-v} = 1; $self->info(qq{Executing `"$self->{executable}" -v`}); my $version = `"$self->{executable}" -v`; unless ($version) { $self->error("Failed to find Apache version data with ", qq{`"$self->{executable}" -v`}); return; } chomp $version; my ($n, $x, $y, $z) = $version =~ /Server\s+version:\s+([^\/]*)\/(\d+)\.(\d+).(\d+)/; unless ($n and $x and defined $y and defined $z) { $self->error("Failed to parse Apache name and ", "version from string '$version'"); return; } @{$self}{qw(name version major minor patch)} = ($n, "$x.$y.$z", $x, $y, $z); }; sub name { my $self = shift; return unless $self->{executable}; # Load data. $get_version->($self) unless exists $self->{-v}; # Handle an unknown name. $self->{name} ||= $self->unknown( key => 'apache name' ); # Return the name. return $self->{name}; } ############################################################################## =head3 version my $version = $apache->version; Returns the apache version number. App::Info::HTTPD::Apache parses the version number from the system call C<`httpd -v`>. B =over 4 =item info Executing `httpd -v` =item error Failed to find Apache version data with `httpd -v` Failed to parse Apache name and version from string =item unknown Enter a valid Apache version number =back =cut sub version { my $self = shift; return unless $self->{executable}; # Load data. $get_version->($self) unless exists $self->{-v}; # 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 => 'apache version number', callback => $chk_version); } # Return the version number. return $self->{version}; } ############################################################################## =head3 major_version my $major_version = $apache->major_version; Returns the Apache major version number. App::Info::HTTPD::Apache parses the version number from the system call C<`httpd --v`>. For example, if C returns "1.3.24", then this method returns "1". B =over 4 =item info Executing `httpd -v` =item error Failed to find Apache version data with `httpd -v` Failed to parse Apache name and version from string =item unknown Enter a valid Apache 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->{executable}; # Load data. $get_version->($self) unless exists $self->{-v}; # Handle an unknown value. $self->{major} = $self->unknown( key => 'apache major version number', callback => $is_int) unless $self->{major}; return $self->{major}; } ############################################################################## =head3 minor_version my $minor_version = $apache->minor_version; Returns the Apache minor version number. App::Info::HTTPD::Apache parses the version number from the system call C<`httpd --v`>. For example, if C returns "1.3.24", then this method returns "3". See the L method for a list of possible errors. B =over 4 =item info Executing `httpd -v` =item error Failed to find Apache version data with `httpd -v` Failed to parse Apache name and version from string =item unknown Enter a valid Apache minor version number =back =cut sub minor_version { my $self = shift; return unless $self->{executable}; # Load data. $get_version->($self) unless exists $self->{-v}; # Handle an unknown value. $self->{minor} = $self->unknown( key => 'apache minor version number', callback => $is_int) unless defined $self->{minor}; return $self->{minor}; } ############################################################################## =head3 patch_version my $patch_version = $apache->patch_version; Returns the Apache patch version number. App::Info::HTTPD::Apache parses the version number from the system call C<`httpd --v`>. For example, if C returns "1.3.24", then this method returns "24". B =over 4 =item info Executing `httpd -v` =item error Failed to find Apache version data with `httpd -v` Failed to parse Apache name and version from string =item unknown Enter a valid Apache patch version number =back =cut sub patch_version { my $self = shift; return unless $self->{executable}; # Load data. $get_version->($self) unless exists $self->{-v}; # Handle an unknown value. $self->{patch} = $self->unknown( key => 'apache patch version number', callback => $is_int) unless defined $self->{patch}; return $self->{patch}; } ############################################################################## =head3 httpd_root my $httpd_root = $apache->httpd_root; Returns the HTTPD root directory path. This path is defined at compile time, and App::Info::HTTPD::Apache parses it from the system call C<`httpd -V`>. B =over 4 =item info Executing `httpd -V` =item error Unable to extract compile settings from `httpd -V` Cannot parse HTTPD root from `httpd -V` =item unknown Enter a valid HTTPD root =back =cut # This code ref takes care of processing the compile settings. It is used by # httpd_root(), magic_number(), or compile_option(), whichever is called # first. my $get_compile_settings = sub { my $self = shift; $self->{-V} = 1; $self->info(qq{Executing `"$self->{executable}" -V`}); # Get the compile settings. my $data = `"$self->{executable}" -V`; unless ($data) { $self->error("Unable to extract compile settings from ", qq{`"$self->{executable}" -V`}); return; } # Split out the parts. foreach (split /\s*\n\s*/, $data) { if (/magic\s+number:\s+(.*)$/i) { $self->{magic_number} = $1; } elsif (/=/) { $_ =~ s/^-D\s+//; $_ =~ s/"$//; my ($k, $v) = split /\s*=\s*"/, $_; $self->{lc $k} = $v; if (WIN32) { if ($k eq 'SUEXEC_BIN') { $self->{lc $k} = 0; } elsif ($k eq 'HTTPD_ROOT') { $self->{lc $k} = join('\\', (split /\\/, $self->{executable} )[0 .. 1]); } } } elsif (/-D/) { $_ =~ s/^-D\s+//; $self->{lc $_} = 1; } } # Issue a warning if no httpd root was found. $self->error("Cannot parse HTTPD root from ", qq{`"$self->{executable}" -V`}) unless $self->{httpd_root}; }; # This code reference is used by httpd_root(), lib_dir(), bin_dir(), and # so_lib_dir() to validate a directory entered by the user. my $is_dir = sub { -d }; sub httpd_root { my $self = shift; return unless $self->{executable}; # Get the compile settings. $get_compile_settings->($self) unless $self->{-V}; # Handle an unknown value. $self->{httpd_root} = $self->unknown( key => 'apache httpd root', callback => $is_dir) unless defined $self->{httpd_root}; return $self->{httpd_root}; } ############################################################################## =head3 magic_number my $magic_number = $apache->magic_number; Returns the "Magic Number" for the Apache installation. This number is defined at compile time, and App::Info::HTTPD::Apache parses it from the system call C<`httpd -V`>. B =over 4 =item info Executing `httpd -V` =item error Unable to extract compile settings from `httpd -V` Cannot parse HTTPD root from `httpd -V` =item unknown Enter a valid magic number =back =cut sub magic_number { my $self = shift; return unless $self->{executable}; # Get the compile settings. $get_compile_settings->($self) unless $self->{-V}; # Handle an unknown value. $self->{magic_number} = $self->unknown( key => 'apache magic number' ) unless defined $self->{magic_number}; return $self->{magic_number}; } ############################################################################## =head3 compile_option my $compile_option = $apache->compile_option($option); Returns the value of the Apache compile option C<$option>. The compile option is looked up case-insensitively. All of the Apache compile options are collected from the system call C<`httpd -V`>. For compile options that contain a corresponding value (such as "SUEXEC_BIN" or "DEFAULT_PIDLOG"), C returns the value of the option if the option exists. For other options, it returns true (1) if the option was included, and false(C) if it was not. Returns C if Apache is not installed or if the option could not be parsed. See the L method for a list of possible errors. See the Apache documentation at L to learn about all the possible compile options. B =over 4 =item info Executing `httpd -V` =item error Unable to extract compile settings from `httpd -V` Cannot parse HTTPD root from `httpd -V` =item unknown Enter a valid option =back =cut sub compile_option { my $self = shift; return unless $self->{executable}; # Get the compile settings. $get_compile_settings->($self) unless $self->{-V}; # Handle an unknown value. my $option = lc $_[0]; $self->{$option} = $self->unknown( key => "apache option $option" ) unless defined $self->{$option}; return $self->{$option}; } ############################################################################## =head3 conf_file Returns the full path to the Apache configuration file. C looks for the configuration file in a number of locations and under a number of names. First it tries to use the file specified by the C compile option (as returned by a call to C) -- and if it's a relative file name, it gets appended to the directory returned by C. If that file isn't found, C then looks for a file with one of the names returned by C in the F subdirectory of the HTTPD root directory. Failing that, it searches for them in each of the directories returned by C until it finds a match. B =over 4 =item info Searching for Apache configuration file =item error No Apache config file found =item unknown Location of httpd.conf file? =back =cut sub conf_file { my $self = shift; return unless $self->{executable}; unless (exists $self->{conf_file}) { $self->info("Searching for Apache configuration file"); my $root = $self->httpd_root; my $conf = $self->compile_option('SERVER_CONFIG_FILE'); $conf = $u->file_name_is_absolute($conf) ? $conf : $u->catfile($root, $conf) if $conf; if ($conf && -f $conf) { $self->{conf_file} = $conf; } else { # Paths to search. 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 my $user = $apache->user; Returns the name of the Apache user. This value is collected from the Apache configuration file as returned by C. B =over 4 =item info Searching for Apache configuration file Executing `httpd -V` Parsing Apache configuration file =item error No Apache config file found Cannot parse user from file Cannot parse group from file Cannot parse port from file Cannot parse DocumentRoot from file =item unknown Location of httpd.conf file? Enter Apache user name =back =cut # This code reference parses the Apache configuration file. It is called by # user(), group(), or port(), whichever gets called first. my $parse_conf_file = sub { my $self = shift; return if exists $self->{user}; $self->{user} = undef; # Find the configuration file. my $conf = $self->conf_file or return; $self->info("Parsing Apache configuration file"); # This is the place to add more regexes to collect stuff from the # config file in the future. my @regexen = ( qr/^\s*User\s+(.*)$/, qr/^\s*Group\s+(.*)$/, qr/^\s*Port\s+(.*)$/, qr/^\s*DocumentRoot\s+"?([^"]+)"?\s*$/, qr/^\s*ScriptAlias\s+( \S+?)\s"?(?:[^"\r\n]+)"?\s*$/x, qr/^\s*ScriptAlias\s+(?:\S+?)\s"?( [^"\r\n]+)"?\s*$/x, ); my ($usr, $grp, $prt, $droot, $cgibinv, $cgibinp) = $u->multi_search_file($conf, @regexen); # Issue a warning if we couldn't find the user and group. $self->error("Cannot parse user from file '$conf'") unless $usr; $self->error("Cannot parse group from file '$conf'") unless $grp; $self->error("Cannot parse port from file '$conf'") unless $prt; $self->error("Cannot parse DocumentRoot from file '$conf'") unless $droot; $self->error("Cannot parse ScriptAlias from file '$conf'") if (! ($cgibinv && $cgibinp)); # 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 Returns the name of the Apache user group. This value is collected from the Apache configuration file as returned by C. B =over 4 =item info Searching for Apache configuration file Executing `httpd -V` Parsing Apache configuration file =item error No Apache config file found Cannot parse user from file Cannot parse group from file Cannot parse port from file Cannot parse DocumentRoot from file =item unknown Location of httpd.conf file? Enter Apache user group name =back =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 Returns the port number on which Apache listens. This value is collected from Apache configuration file as returned by C. B =over 4 =item info Searching for Apache configuration file Executing `httpd -V` Parsing Apache configuration file =item error No Apache config file found Cannot parse user from file Cannot parse group from file Cannot parse port from file Cannot parse DocumentRoot from file =item unknown Location of httpd.conf file? Enter Apache TCP/IP port number =back =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 Returns the local physical path where web pages are stored. This value is collected from Apache configuration file as returned by C. B =over 4 =item info Searching for Apache configuration file Executing `httpd -V` Parsing Apache configuration file =item error No Apache config file found Cannot parse user from file Cannot parse group from file Cannot parse port from file Cannot parse DocumentRoot from file =item unknown Location of httpd.conf file? Enter DocumentRoot actual directory =back =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 Returns the virtual path where cgi-bin programs are stored. This value is collected from Apache configuration file as returned by C. B =over 4 =item info Searching for Apache configuration file Executing `httpd -V` Parsing Apache configuration file =item error No Apache config file found Cannot parse user from file Cannot parse group from file Cannot parse port from file Cannot parse ScriptAlias from file =item unknown Location of httpd.conf file? Enter ScriptAlias virtual directory =back =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 Returns the physical path where cgi-bin programs are stored. This value is collected from Apache configuration file as returned by C. B =over 4 =item info Searching for Apache configuration file Executing `httpd -V` Parsing Apache configuration file =item error No Apache config file found Cannot parse user from file Cannot parse group from file Cannot parse port from file Cannot parse ScriptAlias from file =item unknown Location of httpd.conf file? Enter ScriptAlias physical directory =back =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 my $executable = $apache->executable; Returns the path to the Apache executable, which will be defined by one of the names returned by C. The executable is searched for in C, so there are no events for this method. =head3 httpd my $httpd = $apache->httpd; An alias for C. =cut sub executable { shift->{executable} } ############################################################################## =head3 bin_dir my $bin_dir = $apache->bin_dir; Returns the SQLite binary directory path. App::Info::HTTPD::Apache simply retrieves it as the directory part of the path to the HTTPD executable. =cut sub bin_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{bin_dir} ) { my @parts = $u->splitpath($self->{executable}); $self->{bin_dir} = $u->catdir( ($parts[0] eq '' ? () : $parts[0]), $u->splitdir($parts[1]) ); } return $self->{bin_dir}; } ############################################################################## =head3 inc_dir my $inc_dir = $apache->inc_dir; Returns the Apache include directory path. App::Info::HTTPD::Apache simply looks for the F or F directory under the F directory, as returned by C. B =over 4 =item info Executing `httpd -V` Searching for include directory =item error Unable to extract compile settings from `httpd -V` Cannot parse HTTPD root from `httpd -V` Cannot find include directory =item unknown Enter a valid HTTPD root Enter a valid Apache include directory =back =cut sub inc_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{inc_dir}) {{ my $root = $self->httpd_root || last; # Double braces allow this. $self->info("Searching for include directory"); $self->{inc_dir} = $u->first_dir($self->search_inc_dirs) or $self->error("Cannot find include directory"); }} # Handle unknown value. $self->{inc_dir} = $self->unknown( key => 'apache inc dir', callback => $is_dir) unless $self->{inc_dir}; return $self->{inc_dir}; } ############################################################################## =head3 lib_dir my $lib_dir = $apache->lib_dir; Returns the Apache library directory path. App::Info::HTTPD::Apache simply looks for the F, F, or F directory under the HTTPD root> directory, as returned by C. B =over 4 =item info Executing `httpd -V` Searching for library directory =item error Unable to extract compile settings from `httpd -V` Cannot parse HTTPD root from `httpd -V` Cannot find library directory =item unknown Enter a valid HTTPD root Enter a valid Apache library directory =back =cut sub lib_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{lib_dir}) { if ($self->httpd_root) { $self->info("Searching for library directory"); if (my $d = $u->first_dir($self->search_lib_dirs)) { $self->{lib_dir} = $d; } else { $self->error("Cannot find library direcory"); } } else { # Handle unknown value. $self->{lib_dir} = $self->unknown( key => 'apache lib dir', callback => $is_dir ); } } return $self->{lib_dir}; } ############################################################################## =head3 so_lib_dir my $so_lib_dir = $apache->so_lib_dir; Returns the Apache shared object library directory path. Currently, this directory is assumed to be the same as the lib directory, so this method is simply an alias for C. B =over 4 =item info Executing `httpd -V` Searching for library directory =item error Unable to extract compile settings from `httpd -V` Cannot parse HTTPD root from `httpd -V` Cannot find library directory =item unknown Enter a valid HTTPD root Enter a valid Apache library directory =back =cut # For now, at least, these seem to be the same. *so_lib_dir = \&lib_dir; ############################################################################## =head3 static_mods Returns a list (in an array context) or an anonymous array (in a scalar context) of all of the modules statically compiled into Apache. These are collected from the system call C<`httpd -l`>. If Apache is not installed, C returns an empty list in an array context or an empty anonymous array in a scalar context. B =over 4 =item info Executing `httpd -l` =item error Unable to extract needed data from `httpd -l` =back =cut # This code reference collects the list of static modules from Apache. Used by # static_mods(), mod_perl(), or mod_so(), whichever gets called first. my $get_static_mods = sub { my $self = shift; $self->{static_mods} = undef; $self->info(qq{Executing `"$self->{executable}" -l`}); my $data = `"$self->{executable}" -l`; unless ($data) { $self->error("Unable to extract needed data from ". qq{`"$self->{executable}" -l`}); return; } # Parse out the modules. my @mods; while ($data =~ /^\s*(\w+)\.c\s*$/mg) { push @mods, $1; $self->{mod_so} = 1 if $1 eq 'mod_so'; $self->{mod_perl} = 1 if $1 eq 'mod_perl'; } $self->{static_mods} = \@mods if @mods; }; sub static_mods { my $self = shift; return unless $self->{executable}; $get_static_mods->($self) unless exists $self->{static_mods}; return unless $self->{static_mods}; return wantarray ? @{$self->{static_mods}} : $self->{static_mods}; } ############################################################################## =head3 shared_mods Returns a list (in an array context) or an anonymous array (in a scalar context) of all of the shared modules compiled for Apache. These are collected by searching for all files ending in F<.so> in the directory returned from the system call C<`apxs -q LIBEXECDIR`>. If Apache is not installed, C returns an empty list in an array context or an empty anonymous array in a scalar context. B =over 4 =item info Looking for apxs Executing `apxs -q LIBEXECDIR` =item error Unable to extract module directory name from `apxs -q LIBEXECDIR` =back =cut # This code reference collects the list of static modules from Apache. Used by # static_mods() and mod_perl(), whichever gets called first. my $get_shared_mods = sub { my $self = shift; my $apxs = $self->apxs or return; $self->info(qq{Executing `"$apxs" -q LIBEXECDIR`}); my $mod_dir = `"$apxs" -q LIBEXECDIR`; chomp $mod_dir; return $self->error( qq{Unable to extract module directory name `"$apxs" -q LIBEXECDIR`} ) unless $mod_dir && -d $mod_dir; $self->{so_mods} = $u->files_in_dir( $mod_dir, sub { s/\.so$//} ); $self->{mod_perl} ||= grep { /perl/ } @{ $self->{so_mods} }; }; sub shared_mods { my $self = shift; return unless $self->{executable}; $get_shared_mods->($self) unless exists $self->{so_mods}; return unless $self->{static_mods}; return wantarray ? @{$self->{so_mods}} : $self->{so_mods}; } ############################################################################## =head3 mod_so Boolean method that returns true when mod_so has been compiled into Apache, and false if it has not. The presence or absence of mod_so is determined by the system call C<`httpd -l`>. B =over 4 =item info Executing `httpd -l` =item error Unable to extract needed data from `httpd -l` =back =cut sub mod_so { my $self = shift; return unless $self->{executable}; $get_static_mods->($self) unless exists $self->{static_mods}; return $self->{mod_so}; } ############################################################################## =head3 mod_perl Boolean method that returns true when mod_perl has been statically compiled into Apache, and false if it has not. The presence or absence of mod_perl is determined by the system call C<`httpd -l`> or, for a dynamic mod_perl, by the contents of the directory returned by the system call C<`apxs -q LIBEXECDIR`>. B =over 4 =item info Executing `httpd -l` Looking for apxs Executing `apxs -q LIBEXECDIR` =item error Unable to extract needed data from `httpd -l` =back =cut sub mod_perl { my $self = shift; return unless $self->{executable}; $get_static_mods->($self) unless exists $self->{static_mods}; $get_shared_mods->($self) unless $self->{mod_perl} || exists $self->{so_mods}; return $self->{mod_perl}; } ############################################################################## =head3 home_url my $home_url = $apache->home_url; Returns the Apache home page URL. =cut sub home_url { "http://httpd.apache.org/" } ############################################################################## =head3 download_url my $download_url = $apache->download_url; Returns the Apache download URL. =cut sub download_url { "http://www.apache.org/dist/httpd/" } ############################################################################## =head3 search_exe_names my @search_exe_names = $apache->search_exe_names; Returns a list of possible names for the Apache executable; F<.exe> is appended to each on Win32. By default, the names are: =over =item httpd =item httpd2 =item apache-perl =item apache =item apache2 =back =cut sub search_exe_names { my $self = shift; my @exes = qw(httpd httpd2 apache-perl apache apache2); if (WIN32) { $_ .= ".exe" for @exes } return ( $self->SUPER::search_exe_names, @exes ); } ############################################################################## =head3 search_bin_dirs my @search_bin_dirs = $apache->search_bin_dirs; Returns a list of possible directories in which to search an executable. Used by the C constructor to find an executable to execute and collect application info. The found directory will also be returned by the C method. The list of directories by default consists of the path as defined by C<< File::Spec->path >> and the value returned by C<< Apache2::BuildConfig->new->{APXS_BINDIR} >> (if Apache2::BuildConfig is installed), as well as the following directories: =over 4 =item /usr/local/apache/bin =item /usr/local/apache2/bin =item /opt/apache/bin =item /opt/apache2/bin =item /usr/local/bin =item /usr/local/sbin =item /usr/bin =item /usr/sbin =item /bin =item /etc/httpd/bin =item /etc/apache/bin =item /etc/apache2/bin =item /home/httpd/bin =item /home/apache/bin =item /home/apache2/bin =item /sw/bin =item /sw/sbin =item /web/httpd =back =cut sub search_bin_dirs { # See if mod_perl2 knows where Apache is installed. eval { require Apache2::BuildConfig }; my @path = $@ ? () : Apache2::BuildConfig->new->{APXS_BINDIR}; return ( shift->SUPER::search_bin_dirs, $u->path, @path, qw( /usr/local/apache/bin /usr/local/apache2/bin /opt/apache/bin /opt/apache2/bin /usr/local/bin /usr/local/sbin /usr/bin /usr/sbin /bin /etc/httpd/bin /etc/apache/bin /etc/apache2/bin /home/httpd/bin /home/apache2/bin /home/apache/bin /sw/bin /sw/sbin /web/httpd ) ); } ############################################################################## =head3 search_lib_dirs my @search_lib_dirs = $apache->search_lib_dirs; Returns a list of possible directories in which to search for Apache libraries. By default, it returns this list of directories, each appended to the name of the directory returned by C: =over 4 =item lib =item modules =item libexec =back =cut sub search_lib_dirs { my $self = shift; my $root = $self->httpd_root; return ( $self->SUPER::search_lib_dirs, ( $root ? map { $u->catdir($root, $_) } qw(lib libexec modules) : () ), '/usr/lib/apache/1.3', '/usr/lib/apache/2.0', ); } ############################################################################## =head3 search_inc_dirs my @search_inc_dirs = $apache->search_inc_dirs; Returns a list of possible directories in which to search for Apache include files. By default, it returns this list of directories, each appended to the name of the directory returned by C: =over 4 =item include =item inc =back =cut sub search_inc_dirs { my $self = shift; my $root = $self->httpd_root; return ( $self->SUPER::search_inc_dirs, ( $root ? map { $u->catdir($root, $_) } qw(include inc) : () ), ); } ############################################################################## =head3 search_conf_names my @search_conf_dirs = $apache->search_conf_dirs; Returns a list of possible names for Apache configuration files. These will be used bye the C method to search for Apache configuration files. By Default, the possible configuration file names are: =over 4 =item F =item F =back =cut sub search_conf_names { return ( @{ shift->{search_conf_names} }, qw(httpd.conf httpd.conf.default) ); } ############################################################################## =head3 search_conf_dirs my @search_conf_dirs = $apache->search_conf_dirs; Returns a list of directories in which the C method will search for Apache configuration files. =over 4 =item /usr/share/doc/apache-perl =item /etc/httpd =back =cut sub search_conf_dirs { return ( @{ shift->{search_conf_dirs} }, qw(/usr/share/doc/apache-perl /etc/httpd) ); } ############################################################################## =head2 Other Executable Methods These methods return the complete paths to their like-named executables. Apache comes with a fair number of them; we provide these methods to provide a path to a subset of them. Each method, when called, checks for an executable in the directory returned by C. The name of the executable must be one of the names returned by the corresponding C method. The available executable methods are: =over =item ab =item apachectl =item apxs =item htdigest =item htpasswd =item logresolve =item rotatelogs =back And the corresponding search names methods are: =over =item search_ab_names =item search_apachectl_names =item search_apxs_names =item search_htdigest_names =item search_htpasswd_names =item search_logresolve_names =item search_rotatelogs_names =back B =over 4 =item info Looking for executable =item confirm Path to executable? =item unknown Path to executable? =back =cut my $find_exe = sub { my ($self, $key) = @_; my $exe = $key . (WIN32 ? '.exe' : ''); my $meth = "search_$key\_names"; # 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) { no strict 'refs'; *{$exe} = sub { shift->$find_exe($exe) }; *{"search_$exe\_names"} = sub { @{ shift->{"search_$exe\_names"} } } } *httpd = \&executable; 1; __END__ =head1 KNOWN ISSUES It's likely that a lot more can be done to collect data about Apache. The methodology for determining the lib, inc, bin, and so_lib directories in particular may be considered rather weak. And the Port number can be specified multiple ways (and times!) in an Apache configuration file. Patches from those who know a great deal more about interrogating Apache will be most welcome. =head1 TO DO Add method to return the names of available DSOs. These should either be parsed from the F file or Cbed from the file system. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler based on code by Sam Tregar . =head1 SEE ALSO L documents the event handling interface. L is the App::Info::HTTP::Apache parent class. L and L document mod_perl. L is the Apache web server home page. L is the mod_perl home page. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Lib000755000765000024 011577311664 15333 5ustar00davidstaff000000000000App-Info-0.57/lib/App/Info/Lib/Expat.pm000444000765000024 4371411577311664 17140 0ustar00davidstaff000000000000package App::Info::Lib::Expat; =head1 NAME App::Info::Lib::Expat - Information about the Expat XML parser =head1 SYNOPSIS use App::Info::Lib::Expat; my $expat = App::Info::Lib::Expat->new; if ($expat->installed) { print "App name: ", $expat->name, "\n"; print "Version: ", $expat->version, "\n"; print "Bin dir: ", $expat->bin_dir, "\n"; } else { print "Expat is not installed. :-(\n"; } =head1 DESCRIPTION App::Info::Lib::Expat supplies information about the Expat XML parser installed on the local system. It implements all of the methods defined by App::Info::Lib. Methods that trigger events will trigger them only the first time they're called (See L for documentation on handling events). To start over (after, say, someone has installed Expat) construct a new App::Info::Lib::Expat object to aggregate new meta data. 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 "Searching for 'expat.h'" is documented for the methods C, C, C, and C, rest assured that it will only be triggered once, by whichever of those four methods is called first. =cut use strict; use App::Info::Util; use App::Info::Lib; use vars qw(@ISA $VERSION); @ISA = qw(App::Info::Lib); $VERSION = '0.57'; my $u = App::Info::Util->new; ############################################################################## =head1 INTERFACE =head2 Constructor =head3 new my $expat = App::Info::Lib::Expat->new(@params); Returns an App::Info::Lib::Expat object. See L for a complete description of argument parameters. When called, C searches all of the paths returned by the C method for one of the files returned by the C method. If any of is found, then Expat is assumed to be installed. Otherwise, most of the object methods will return C. B =over 4 =item info Searching for Expat libraries =item confirm Path to Expat library directory? =item unknown Path to Expat library directory? =back =cut sub new { # Construct the object. 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 =head3 key_name my $key_name = App::Info::Lib::Expat->key_name; Returns the unique key name that describes this class. The value returned is the string "Expat". =cut sub key_name { 'Expat' } ############################################################################## =head2 Object Methods =head3 installed print "Expat is ", ($expat->installed ? '' : 'not '), "installed.\n"; Returns true if Expat is installed, and false if it is not. App::Info::Lib::Expat determines whether Expat is installed based on the presence or absence on the file system of one of the files searched for when C constructed the object. If Expat does not appear to be installed, then most of the other object methods will return empty values. =cut sub installed { $_[0]->{libexpat} ? 1 : undef } ############################################################################## =head3 name my $name = $expat->name; Returns the name of the application. In this case, C simply returns the string "Expat". =cut sub name { 'Expat' } ############################################################################## =head3 version Returns the full version number for Expat. App::Info::Lib::Expat attempts parse the version number from the F file, if it exists. B =over 4 =item info Searching for 'expat.h' Searching for include directory =item error Cannot find include directory Cannot find 'expat.h' Failed to parse version from 'expat.h' =item unknown Enter a valid Expat include directory Enter a valid Expat version number =back =cut my $get_version = sub { my $self = shift; $self->{version} = undef; $self->info("Searching for 'expat.h'"); my $inc = $self->inc_dir or ($self->error("Cannot find 'expat.h'")) && return; my $header = $u->catfile($inc, 'expat.h'); my @regexen = ( qr/XML_MAJOR_VERSION\s+(\d+)$/, qr/XML_MINOR_VERSION\s+(\d+)$/, qr/XML_MICRO_VERSION\s+(\d+)$/ ); my ($x, $y, $z) = $u->multi_search_file($header, @regexen); if (defined $x and defined $y and defined $z) { # Assemble the version number and store it. my $v = "$x.$y.$z"; @{$self}{qw(version major minor patch)} = ($v, $x, $y, $z); } else { # Warn them if we couldn't get them all. $self->error("Failed to parse version from '$header'"); } }; sub version { my $self = shift; return unless $self->{libexpat}; # Get data. $get_version->($self) unless exists $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 => 'expat version number', callback => $chk_version); } return $self->{version}; } ############################################################################## =head3 major_version my $major_version = $expat->major_version; Returns the Expat major version number. App::Info::Lib::Expat attempts to parse the version number from the F file, if it exists. For example, if C returns "1.95.2", then this method returns "1". B =over 4 =item info Searching for 'expat.h' Searching for include directory =item error Cannot find include directory Cannot find 'expat.h' Failed to parse version from 'expat.h' =item unknown Enter a valid Expat include directory Enter a valid Expat 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->{libexpat}; # Get data. $get_version->($self) unless exists $self->{version}; # Handle an unknown value. $self->{major} = $self->unknown( key => 'expat major version number', callback => $is_int) unless $self->{major}; return $self->{major}; } ############################################################################## =head3 minor_version my $minor_version = $expat->minor_version; Returns the Expat minor version number. App::Info::Lib::Expat attempts to parse the version number from the F file, if it exists. For example, if C returns "1.95.2", then this method returns "95". B =over 4 =item info Searching for 'expat.h' Searching for include directory =item error Cannot find include directory Cannot find 'expat.h' Failed to parse version from 'expat.h' =item unknown Enter a valid Expat include directory Enter a valid Expat minor version number =back =cut sub minor_version { my $self = shift; return unless $self->{libexpat}; # Get data. $get_version->($self) unless exists $self->{version}; # Handle an unknown value. $self->{minor} = $self->unknown( key =>'expat minor version number', callback => $is_int) unless $self->{minor}; return $self->{minor}; } ############################################################################## =head3 patch_version my $patch_version = $expat->patch_version; Returns the Expat patch version number. App::Info::Lib::Expat attempts to parse the version number from the F file, if it exists. For example, C returns "1.95.2", then this method returns "2". B =over 4 =item info Searching for 'expat.h' Searching for include directory =item error Cannot find include directory Cannot find 'expat.h' Failed to parse version from 'expat.h' =item unknown Enter a valid Expat include directory Enter a valid Expat patch version number =back =cut sub patch_version { my $self = shift; return unless $self->{libexpat}; # Get data. $get_version->($self) unless exists $self->{version}; # Handle an unknown value. $self->{patch} = $self->unknown( key => 'expat patch version number', callback => $is_int) unless $self->{patch}; return $self->{patch}; } ############################################################################## =head3 bin_dir my $bin_dir = $expat->bin_dir; Since Expat includes no binaries, this method always returns false. =cut sub bin_dir { return } ############################################################################## =head3 executable my $executable = $expat->executable; Since Expat includes no executable program, this method always returns false. =cut sub executable { return } ############################################################################## =head3 inc_dir my $inc_dir = $expat->inc_dir; Returns the directory path in which the file F was found. App::Info::Lib::Expat searches for F in the following directories: =over 4 =item /usr/local/include =item /usr/include =item /sw/include =back B =over 4 =item info Searching for include directory =item error Cannot find include directory =item unknown Enter a valid Expat include directory =back =cut # This code reference is used by inc_dir() and so_lib_dir() to validate a # directory entered by the user. my $is_dir = sub { -d }; sub inc_dir { my $self = shift; return unless $self->{libexpat}; unless (exists $self->{inc_dir}) { $self->info("Searching for include directory"); my @incs = $self->search_inc_names; if (my $dir = $u->first_cat_dir(\@incs, $self->search_inc_dirs)) { $self->{inc_dir} = $dir; } else { $self->error("Cannot find include directory"); my $cb = sub { $u->first_cat_dir(\@incs, $_) }; $self->{inc_dir} = $self->unknown( key => 'explat inc dir', callback => $cb, error => "No expat include file found in " . "directory"); } } return $self->{inc_dir}; } ############################################################################## =head3 lib_dir my $lib_dir = $expat->lib_dir; Returns the directory path in which a Expat library was found. The files and paths searched are as described for the L<"new"|new> constructor, as are the events. =cut sub lib_dir { $_[0]->{libexpat} } ############################################################################## =head3 so_lib_dir my $so_lib_dir = $expat->so_lib_dir; Returns the directory path in which a Expat shared object library was found. It searches all of the paths in the C and C attributes defined by the Perl L module -- plus F (for all you Fink fans) -- for one of the following files: =over =item libexpat.so =item libexpat.so.0 =item libexpat.so.0.0.1 =item libexpat.dylib =item libexpat.0.dylib =item libexpat.0.0.1.dylib =back B =over 4 =item info Searching for shared object library directory =item error Cannot find shared object library directory =item unknown Enter a valid Expat shared object library directory =back =cut sub so_lib_dir { my $self = shift; return unless $self->{libexpat}; unless (exists $self->{so_lib_dir}) { $self->info("Searching for shared object library directory"); my @libs = $self->search_so_lib_names; my $cb = sub { $u->first_cat_dir(\@libs, $_) }; if (my $dir = $u->first_cat_dir(\@libs, $self->search_lib_dirs)) { $self->{so_lib_dir} = $dir; } else { $self->error("Cannot find shared object library directory"); $self->{so_lib_dir} = $self->unknown( key => 'expat so dir', callback => $cb, error => "Shared object libraries not " . "found in directory"); } } return $self->{so_lib_dir}; } =head3 home_url my $home_url = $expat->home_url; Returns the libexpat home page URL. =cut sub home_url { 'http://expat.sourceforge.net/' } =head3 download_url my $download_url = $expat->download_url; Returns the libexpat download URL. =cut sub download_url { 'http://sourceforge.net/projects/expat/' } ############################################################################## =head3 search_lib_names my @seach_lib_names = $self->search_lib_nams Returns a list of possible names for library files. Used by C to search for library files. By default, the list is: =over =item libexpat.a =item libexpat.la =item libexpat.so =item libexpat.so.0 =item libexpat.so.0.0.1 =item libexpat.dylib =item libexpat.0.dylib =item libexpat.0.0.1.dylib =back =cut sub search_lib_names { my $self = shift; return $self->SUPER::search_lib_names, map { "libexpat.$_"} qw(a la so so.0 so.0.0.1 dylib 0.dylib 0.0.1.dylib); } ############################################################################## =head3 search_so_lib_names my @seach_so_lib_names = $self->search_so_lib_nams Returns a list of possible names for shared object library files. Used by C to search for library files. By default, the list is: =over =item libexpat.so =item libexpat.so.0 =item libexpat.so.0.0.1 =item libexpat.dylib =item libexpat.0.dylib =item libexpat.0.0.1.dylib =back =cut sub search_so_lib_names { my $self = shift; return $self->SUPER::search_so_lib_names, map { "libexpat.$_"} qw(so so.0 so.0.0.1 dylib 0.dylib 0.0.1.dylib); } ############################################################################## =head3 search_lib_dirs my @search_lib_dirs = $expat->search_lib_dirs; Returns a list of possible directories in which to search for libraries. By default, it returns all of the paths in the C and C attributes defined by the Perl L module -- plus F (in support of all you Fink users out there). =cut sub search_lib_dirs { shift->SUPER::search_lib_dirs, $u->lib_dirs, '/sw/lib' } ############################################################################## =head3 search_inc_names my @search_inc_names = $expat->search_inc_names; Returns a list of include file names to search for. Used by C to search for an include file. By default, the only name returned is F. =cut sub search_inc_names { my $self = shift; return $self->SUPER::search_inc_names, "expat.h"; } ############################################################################## =head3 search_inc_dirs my @search_inc_dirs = $expat->search_inc_dirs; Returns a list of possible directories in which to search for include files. Used by C to search for an include file. By default, the directories are: =over 4 =item /usr/local/include =item /usr/include =item /sw/include =back =cut sub search_inc_dirs { shift->SUPER::search_inc_dirs, qw(/usr/local/include /usr/include /sw/include); } 1; __END__ =head1 KNOWN ISSUES This is a pretty simple class. It's possible that there are more directories that ought to be searched for libraries and includes. And if anyone knows how to get the version numbers, let me know! The format of the version number seems to have changed recently (1.95.1-2), and now I don't know where to find the version number. Patches welcome. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler based on code by Sam Tregar that Sam, in turn, borrowed from Clark Cooper's L module. =head1 SEE ALSO L documents the event handling interface. L is the App::Info::Lib::Expat parent class. L uses Expat to parse XML. L provides Perl configure-time information used by App::Info::Lib::Expat to locate Expat libraries and files. L is the Expat home page. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Lib/Iconv.pm000444000765000024 5144411577311664 17134 0ustar00davidstaff000000000000package App::Info::Lib::Iconv; =head1 NAME App::Info::Lib::Iconv - Information about libiconv =head1 SYNOPSIS use App::Info::Lib::Iconv; my $iconv = App::Info::Lib::Iconv->new; if ($iconv->installed) { print "App name: ", $iconv->name, "\n"; print "Version: ", $iconv->version, "\n"; print "Bin dir: ", $iconv->bin_dir, "\n"; } else { print "libiconv is not installed. :-(\n"; } =head1 DESCRIPTION App::Info::Lib::Iconv supplies information about the libiconv library installed on the local system. It implements all of the methods defined by App::Info::Lib. Methods that trigger events will trigger them only the first time they're called (See L for documentation on handling events). To start over (after, say, someone has installed libiconv) construct a new App::Info::Lib::Iconv object to aggregate new meta data. 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 "Searching for 'iconv.h'" is documented for the methods C, C, and C, rest assured that it will only be triggered once, by whichever of those four methods is called first. =cut use strict; use File::Basename (); use App::Info::Util; use App::Info::Lib; use vars qw(@ISA $VERSION); @ISA = qw(App::Info::Lib); $VERSION = '0.57'; use constant WIN32 => $^O eq 'MSWin32'; my $u = App::Info::Util->new; ############################################################################## =head1 INTERFACE =head2 Constructor =head3 new my $iconv = App::Info::Lib::Iconv->new(@params); Returns an App::Info::Lib::Iconv object. See L for a complete description of argument parameters. When called, C searches the the list of directories returned by the C method for an executable file with a name returned by the C method. If the executable is found, libiconv will be assumed to be installed. Otherwise, most of the object methods will return C. B =over 4 =item info Searching for iconv =item unknown Path to iconv executable? =item confirm Path to iconv executable? =back =cut 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; } ############################################################################## =head2 Class Method =head3 key_name my $key_name = App::Info::Lib::Iconv->key_name; Returns the unique key name that describes this class. The value returned is the string "libiconv". =cut sub key_name { 'libiconv' } ############################################################################## =head2 Object Methods =head3 installed print "libiconv is ", ($iconv->installed ? '' : 'not '), "installed.\n"; Returns true if libiconv is installed, and false if it is not. App::Info::Lib::Iconv determines whether libiconv is installed based on the presence or absence of the F application, as found when C constructed the object. If libiconv does not appear to be installed, then most of the other object methods will return empty values. =cut sub installed { $_[0]->{executable} ? 1 : undef } ############################################################################## =head3 name my $name = $iconv->name; Returns the name of the application. In this case, C simply returns the string "libiconv". =cut sub name { 'libiconv' } ############################################################################## =head3 version my $version = $iconv->version; Returns the full version number for libiconv. App::Info::Lib::Iconv attempts to parse the version number from the F file, if it exists. B =over 4 =item info Searching for 'iconv.h' Searching for include directory =item error Cannot find include directory Cannot find 'iconv.h' Cannot parse version number from file 'iconv.h' =item unknown Enter a valid libiconv include directory Enter a valid libiconv version number =back =cut # This code reference is called by version(), major_version(), and # minor_version() to get the version numbers. my $get_version = sub { my $self = shift; $self->{version} = undef; $self->info("Searching for 'iconv.h'"); # Let inc_dir() do the work. unless ($self->inc_dir && $self->{inc_file}) { # No point in continuing if there's no include file. $self->error("Cannot find 'iconv.h'"); return; } # This is the line we're looking for: # #define _LIBICONV_VERSION 0x0107 /* version number: (major<<8) + minor */ my $regex = qr/_LIBICONV_VERSION\s+([^\s]+)\s/; if (my $ver = $u->search_file($self->{inc_file}, $regex)) { # Convert the version number from hex. $ver = hex $ver; # Shift 8. my $major = $ver >> 8; # Left shift 8 and subtract from version. my $minor = $ver - ($major << 8); # Store 'em! @{$self}{qw(version major minor)} = ("$major.$minor", $major, $minor); } else { $self->error("Cannot parse version number from file '$self->{inc_file}'"); } }; sub version { my $self = shift; return unless $self->{executable}; # Get data. $get_version->($self) unless exists $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) = /^(\d+)\.(\d+)$/; # Return false if we didn't get all three. return unless $x and defined $y; # Save both parts. @{$self}{qw(major minor)} = ($x, $y); # Return true. return 1; }; $self->{version} = $self->unknown( key => 'iconv version number', callback => $chk_version); } return $self->{version}; } ############################################################################## =head3 major_version my $major_version = $iconv->major_version; Returns the libiconv major version number. App::Info::Lib::Iconv attempts to parse the version number from the F file, if it exists. For example, if C returns "1.7", then this method returns "1". B =over 4 =item info Searching for 'iconv.h' Searching for include directory =item error Cannot find include directory Cannot find 'iconv.h' Cannot parse version number from file 'iconv.h' =item unknown Enter a valid libiconv include directory Enter a valid libiconv version number =back =cut # This code reference is used by major_version() and minor_version() to # validate a version number entered by a user. my $is_int = sub { /^\d+$/ }; sub major_version { my $self = shift; return unless $self->{executable}; # Get data. $get_version->($self) unless exists $self->{version}; # Handle an unknown value. $self->{major} = $self->unknown( key => 'iconv major version number', callback => $is_int) unless $self->{major}; return $self->{major}; } ############################################################################## =head3 minor_version my $minor_version = $iconv->minor_version; Returns the libiconv minor version number. App::Info::Lib::Iconv attempts to parse the version number from the F file, if it exists. For example, if C returns "1.7", then this method returns "7". B =over 4 =item info Searching for 'iconv.h' Searching for include directory =item error Cannot find include directory Cannot find 'iconv.h' Cannot parse version number from file 'iconv.h' =item unknown Enter a valid libiconv include directory Enter a valid libiconv version number =back =cut sub minor_version { my $self = shift; return unless $self->{executable}; # Get data. $get_version->($self) unless exists $self->{version}; # Handle an unknown value. $self->{minor} = $self->unknown( key => 'iconv minor version number', callback => $is_int) unless $self->{minor}; return $self->{minor}; } ############################################################################## =head3 patch_version my $patch_version = $iconv->patch_version; Since libiconv has no patch number in its version number, this method will always return false. =cut sub patch_version { return } ############################################################################## =head3 executable my $executable = $iconv->executable; Returns the path to the Iconv executable, which will be defined by one of the names returned by C. The executable is searched for in C, so there are no events for this method. =cut sub executable { shift->{executable} } ############################################################################## =head3 bin_dir my $bin_dir = $iconv->bin_dir; Returns the path of the directory in which the F application was found when the object was constructed by C. B =over 4 =item info Searching for bin directory =item error Cannot find bin directory =item unknown Enter a valid libiconv bin directory =back =cut # This code reference is used by inc_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->{executable}; unless (exists $self->{bin_dir}) { # This is all probably redundant, but let's do the drill, anyway. $self->info("Searching for bin directory"); if (my $bin = File::Basename::dirname($self->{executable})) { # We found it! $self->{bin_dir} = $bin; } else { $self->{bin_dir} = $self->unknown( key => 'iconv bin dir', callback => $is_dir ); } } return $self->{bin_dir}; } ############################################################################## =head3 inc_dir my $inc_dir = $iconv->inc_dir; Returns the directory path in which the file F was found. App::Info::Lib::Iconv searches for F in the following directories: =over 4 =item /usr/local/include =item /usr/include =item /sw/include =back B =over 4 =item info Searching for include directory =item error Cannot find include directory =item unknown Enter a valid libiconv include directory =back =cut sub inc_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{inc_dir}) { $self->info("Searching for include directory"); my @incs = $self->search_inc_names; if (my $dir = $u->first_cat_dir(\@incs, $self->search_inc_dirs)) { $self->{inc_dir} = $dir; } else { $self->error("Cannot find include directory"); my $cb = sub { $u->first_cat_dir(\@incs, $_) }; $self->{inc_dir} = $self->unknown( key => 'iconv inc dir', callback => $cb, error => "Iconv include file not found in " . "directory"); } # So which is the include file? Needed for the version number. $self->{inc_file} = $u->first_file( map { $u->catfile($self->{inc_dir}, $_) } @incs ) if $self->{inc_dir}; } return $self->{inc_dir}; } ############################################################################## =head3 lib_dir my $lib_dir = $iconv->lib_dir; Returns the directory path in which a libiconv library was found. The search looks for a file with a name returned by C in a directory returned by C. B =over 4 =item info Searching for library directory =item error Cannot find library directory =item unknown Enter a valid libiconv library directory =back =cut sub lib_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{lib_dir}) { $self->info("Searching for library directory"); my @files = $self->search_lib_names; if (my $dir = $u->first_cat_dir(\@files, $self->search_lib_dirs)) { # Success! $self->{lib_dir} = $dir; } else { $self->error("Cannot not find library direcory"); my $cb = sub { $u->first_cat_dir(\@files, $_) }; $self->{lib_dir} = $self->unknown( key => 'iconv lib dir', callback => $cb, error => "Library files not found in directory" ); } } return $self->{lib_dir}; } ############################################################################## =head3 so_lib_dir my $so_lib_dir = $iconv->so_lib_dir; Returns the directory path in which a libiconv shared object library was found. The search looks for a file with a name returned by C in a directory returned by C. Returns the directory path in which a libiconv shared object library was found. App::Info::Lib::Iconv searches for these files: =over 4 =item info Searching for shared object library directory =item error Cannot find shared object library directory =item unknown Enter a valid libiconv shared object library directory =back =cut sub so_lib_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{so_lib_dir}) { $self->info("Searching for shared object library directory"); my @files = $self->search_so_lib_names; if (my $dir = $u->first_cat_dir(\@files, $self->search_lib_dirs)) { $self->{so_lib_dir} = $dir; } else { $self->error("Cannot find shared object library directory"); my $cb = sub { $u->first_cat_dir(\@files, $_) }; $self->{so_lib_dir} = $self->unknown( key => 'iconv so dir', callback => $cb, error => "Shared object libraries not " . "found in directory"); } } return $self->{so_lib_dir}; } ############################################################################## =head3 home_url my $home_url = $iconv->home_url; Returns the libiconv home page URL. =cut sub home_url { 'http://www.gnu.org/software/libiconv/' } ############################################################################## =head3 download_url my $download_url = $iconv->download_url; Returns the libiconv download URL. =cut sub download_url { 'ftp://ftp.gnu.org/pub/gnu/libiconv/' } ############################################################################## =head3 search_exe_names my @search_exe_names = $iconv->search_exe_names; Returns a list of possible names for the Iconv executable. By default, the only name returned is F (F on Win32). =cut sub search_exe_names { my $self = shift; my @exes = qw(iconv); if (WIN32) { $_ .= ".exe" for @exes } return ($self->SUPER::search_exe_names, @exes); } ############################################################################## =head3 search_bin_dirs my @search_bin_dirs = $iconv->search_bin_dirs; Returns a list of possible directories in which to search an executable. Used by the C constructor to find an executable to execute and collect application info. The found directory will also be returned by the C method. By default, the directories returned are those in your path, followed by these: =over 4 =item F =item F =item F =item F =item F =item F =item F =item F =back =cut sub search_bin_dirs { return ( shift->SUPER::search_bin_dirs, $u->path, qw(/usr/local/bin /usr/bin /bin /sw/bin /usr/local/sbin /usr/sbin/ /sbin /sw/sbin) ); } ############################################################################## =head3 search_lib_names my @seach_lib_names = $self->search_lib_nams Returns a list of possible names for library files. Used by C to search for library files. By default, the list is: =over =item libiconv3.a =item libiconv3.la =item libiconv3.so =item libiconv3.so.0 =item libiconv3.so.0.0.1 =item libiconv3.dylib =item libiconv3.0.dylib =item libiconv3.0.0.1.dylib =item libiconv.a =item libiconv.la =item libiconv.so =item libiconv.so.0 =item libiconv.so.0.0.1 =item libiconv.dylib =item libiconv.2.dylib =item libiconv.2.0.4.dylib =item libiconv.0.dylib =item libiconv.0.0.1.dylib =back =cut sub search_lib_names { my $self = shift; return $self->SUPER::search_lib_names, map { "libiconv.$_"} qw(a la so so.0 so.0.0.1 dylib 2.dylib 2.0.4.dylib 0.dylib 0.0.1.dylib); } ############################################################################## =head3 search_so_lib_names my @seach_so_lib_names = $self->search_so_lib_nams Returns a list of possible names for shared object library files. Used by C to search for library files. By default, the list is: =over =item libiconv3.so =item libiconv3.so.0 =item libiconv3.so.0.0.1 =item libiconv3.dylib =item libiconv3.0.dylib =item libiconv3.0.0.1.dylib =item libiconv.so =item libiconv.so.0 =item libiconv.so.0.0.1 =item libiconv.dylib =item libiconv.0.dylib =item libiconv.0.0.1.dylib =back =cut sub search_so_lib_names { my $self = shift; return $self->SUPER::search_so_lib_names, map { "libiconv.$_"} qw(so so.0 so.0.0.1 dylib 2.dylib 2.0.4.dylib 0.dylib 0.0.1.dylib); } ############################################################################## =head3 search_lib_dirs my @search_lib_dirs = $iconv->search_lib_dirs; Returns a list of possible directories in which to search for libraries. By default, it returns all of the paths in the C and C attributes defined by the Perl L module -- plus F (in support of all you Fink users out there). =cut sub search_lib_dirs { shift->SUPER::search_lib_dirs, $u->lib_dirs, '/sw/lib' } ############################################################################## =head3 search_inc_names my @search_inc_names = $iconv->search_inc_names; Returns a list of include file names to search for. Used by C to search for an include file. By default, the only name returned is F. =cut sub search_inc_names { my $self = shift; return $self->SUPER::search_inc_names, "iconv.h"; } ############################################################################## =head3 search_inc_dirs my @search_inc_dirs = $iconv->search_inc_dirs; Returns a list of possible directories in which to search for include files. Used by C to search for an include file. By default, the directories are: =over 4 =item /usr/local/include =item /usr/include =item /sw/include =back =cut sub search_inc_dirs { shift->SUPER::search_inc_dirs, qw(/usr/local/include /usr/include /sw/include); } 1; __END__ =head1 KNOWN ISSUES This is a pretty simple class. It's possible that there are more directories that ought to be searched for libraries and includes. =head1 TO DO Improve this class by borrowing code from Matt Seargent's AxKit F. =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler based on code by Sam Tregar . =head1 SEE ALSO L, L, L =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/Lib/OSSPUUID.pm000444000765000024 5532511577311664 17333 0ustar00davidstaff000000000000package App::Info::Lib::OSSPUUID; =head1 NAME App::Info::Lib::OSSPUUID - Information about the OSSP UUID library =head1 SYNOPSIS use App::Info::Lib::OSSPUUID; my $uuid = App::Info::Lib::OSSPUUID->new; if ($uuid->installed) { print "App name: ", $uuid->name, "\n"; print "Version: ", $uuid->version, "\n"; print "Bin dir: ", $uuid->bin_dir, "\n"; } else { print "Expat is not installed. :-(\n"; } =head1 DESCRIPTION App::Info::Lib::OSSPUUID supplies information about the OSSP UUID library installed on the local system. It implements all of the methods defined by App::Info::Lib. Methods that trigger events will trigger them only the first time they're called (See L for documentation on handling events). To start over (after, say, someone has installed the OSSP UUID library) construct a new App::Info::Lib::OSSPUUID object to aggregate new meta data. 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 `uuid-config --version`" is documented for the methods C C, C, C, and C, rest assured that it will only be triggered once, by whichever of those four methods is called first. =cut use strict; use App::Info::Util; use App::Info::Lib; use File::Spec::Functions 'catfile'; use vars qw(@ISA $VERSION); @ISA = qw(App::Info::Lib); $VERSION = '0.57'; use constant WIN32 => $^O eq 'MSWin32'; my $u = App::Info::Util->new; ############################################################################## =head1 INTERFACE =head2 Constructor =head3 new my $expat = App::Info::Lib::OSSPUUID->new(@params); Returns an App::Info::Lib::OSSPUUID object. See L for a complete description of argument parameters. When called, C searches all of the paths returned by the C method for one of the files returned by the C method. If any of is found, then the OSSP UUID library is assumed to be installed. Otherwise, most of the object methods will return C. B =over 4 =item info Looking for uuid-config =item confirm Path to uuid-config? =item unknown Path to uuid-config? =back =cut sub new { # Construct the object. my $self = shift->SUPER::new(@_); # 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 { $self->{search_uuid_names} = []; } return $self; } # We'll use this code reference as a common way of collecting data. my $get_data = sub { return unless $_[0]->{uuid_config}; $_[0]->info(qq{Executing `"$_[0]->{uuid_config}" $_[1]`}); my $info = `"$_[0]->{uuid_config}" $_[1]`; chomp $info; return $info; }; ############################################################################## =head2 Class Method =head3 key_name my $key_name = App::Info::Lib::OSSPUUID->key_name; Returns the unique key name that describes this class. The value returned is the string "OSSP UUID". =cut sub key_name { 'OSSP UUID' } ############################################################################## =head2 Object Methods =head3 installed print "UUID is ", ($uuid->installed ? '' : 'not '), "installed.\n"; Returns true if the OSSP UUID library is installed, and false if it is not. App::Info::Lib::OSSPUUID determines whether the library is installed based on the presence or absence on the file system of the C application, searched for when C constructed the object. If the OSSP UUID library does not appear to be installed, then most of the other object methods will return empty values. =cut sub installed { $_[0]->{uuid_config} ? 1 : undef } ############################################################################## =head3 name my $name = $uuid->name; Returns the name of the library. App::Info::Lib::OSSPUUID parses the name from the system call C<`uuid-config --version`>. B =over 4 =item info Executing `uuid-config --version` =item error Failed to find OSSP UUID version with `uuid-config --version` Unable to parse name from string Unable to parse version from string Failed to parse OSSP UUID version parts from string =item unknown Enter a valid OSSP UUID version number =back =cut my $get_version = sub { my $self = shift; $self->{'--version'} = 1; my $data = $get_data->($self, '--version'); unless ($data) { $self->error("Failed to find OSSP UUID version with ". "`$self->{uuid_config} --version`"); return; } # Parse the verison out of the data. chomp $data; my ($name, $version, $date) = $data =~ /(\D+)\s+([\d.]+)\s+\(([^)]+)\)/; # 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) { # Beta/devel/release candidates are treated as patch level "0" @{$self}{qw(version major minor patch)} = ($version, $x, $y, $z); } elsif ($version =~ /(\d+)\.(\d+)/) { # New versions, such as "7.4", are treated as patch level "0" @{$self}{qw(version major minor patch)} = ($version, $1, $2, 0); } else { $self->error("Failed to parse OSSP UUID version parts from " . "string '$version'"); } } else { $self->error("Unable to parse version from string '$data'"); } }; sub name { my $self = shift; return unless $self->{uuid_config}; # Load data. $get_version->($self) unless $self->{'--version'}; # Handle an unknown name. $self->{name} ||= $self->unknown( key => 'OSSP UUID name' ); # Return the name. return $self->{name}; } ############################################################################## =head3 version my $version = $uuid->version; Returns the OSSP UUID version number. App::Info::Lib::OSSPUUID parses the version number from the system call C<`uuid-config --version`>. B =over 4 =item info Executing `uuid-config --version` =item error Failed to find OSSP UUID version with `uuid-config --version` Unable to parse name from string Unable to parse version from string Failed to parse OSSP UUID version parts from string =item unknown Enter a valid OSSP UUID version number =back =cut sub version { my $self = shift; return unless $self->{uuid_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 => 'OSSP UUID version number', callback => $chk_version ); } return $self->{version}; } ############################################################################## =head3 major version my $major_version = $uuid->major_version; Returns the OSSP UUID library major version number. App::Info::Lib::OSSPUUID parses the major version number from the system call C<`uuid-config --version`>. For example, if C returns "1.3.0", then this method returns "1". B =over 4 =item info Executing `uuid-config --version` =item error Failed to find OSSP UUID version with `uuid-config --version` Unable to parse name from string Unable to parse version from string Failed to parse OSSP UUID version parts from string =item unknown Enter a valid OSSP UUID 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->{uuid_config}; # Load data. $get_version->($self) unless exists $self->{'--version'}; # Handle an unknown value. $self->{major} = $self->unknown( key => 'OSSP UUID major version number', callback => $is_int ) unless $self->{major}; return $self->{major}; } ############################################################################## =head3 minor version my $minor_version = $uuid->minor_version; Returns the OSSP UUID library minor version number. App::Info::Lib::OSSPUUID parses the minor version number from the system call C<`uuid-config --version`>. For example, if C returns "1.3.0", then this method returns "3". B =over 4 =item info Executing `uuid-config --version` =item error Failed to find OSSP UUID version with `uuid-config --version` Unable to parse name from string Unable to parse version from string Failed to parse OSSP UUID version parts from string =item unknown Enter a valid OSSP UUID minor version number =back =cut sub minor_version { my $self = shift; return unless $self->{uuid_config}; # Load data. $get_version->($self) unless exists $self->{'--version'}; # Handle an unknown value. $self->{minor} = $self->unknown( key => 'OSSP UUID minor version number', callback => $is_int ) unless defined $self->{minor}; return $self->{minor}; } ############################################################################## =head3 patch version my $patch_version = $uuid->patch_version; Returns the OSSP UUID library patch version number. App::Info::Lib::OSSPUUID parses the patch version number from the system call C<`uuid-config --version`>. For example, if C returns "1.3.0", then this method returns "0". B =over 4 =item info Executing `uuid-config --version` =item error Failed to find OSSP UUID version with `uuid-config --version` Unable to parse name from string Unable to parse version from string Failed to parse OSSP UUID version parts from string =item unknown Enter a valid OSSP UUID minor version number =back =cut sub patch_version { my $self = shift; return unless $self->{uuid_config}; # Load data. $get_version->($self) unless exists $self->{'--version'}; # Handle an unknown value. $self->{patch} = $self->unknown( key => 'OSSP UUID patch version number', callback => $is_int ) unless defined $self->{patch}; return $self->{patch}; } ############################################################################## =head3 executable my $exe = $uuid->executable; Returns the full path to the OSSP UUID executable, which is named F. This method does not use the executable names returned by C; those executable names are used to search for F only (in C). When it called, C checks for an executable named F in the directory returned by C. Note that C is simply an alias for C. B =over 4 =item info Looking for uuid executable =item confirm Path to uuid executable? =item unknown Path to uuid executable? =back =cut sub executable { my $self = shift; my $key = 'uuid'; # 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; ############################################################################## =head3 bin_dir my $bin_dir = $uuid->bin_dir; Returns the OSSP UUID binary directory path. App::Info::Lib::OSSPUUID gathers the path from the system call C<`uuid-config --bindir`>. B =over 4 =item info Executing `uuid-config --bindir` =item error Cannot find bin directory =item unknown Enter a valid OSSP UUID 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->{uuid_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 => 'OSSP UUID bin dir', callback => $is_dir ); } } return $self->{bin_dir}; } ############################################################################## =head3 inc_dir my $inc_dir = $uuid->inc_dir; Returns the OSSP UUID include directory path. App::Info::Lib::OSSPUUID gathers the path from the system call C<`uuid-config --includedir`>. B =over 4 =item info Executing `uuid-config --includedir` =item error Cannot find include directory =item unknown Enter a valid OSSP UUID include directory =back =cut sub inc_dir { my $self = shift; return unless $self->{uuid_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 => 'OSSP UUID include dir', callback => $is_dir ); } } return $self->{inc_dir}; } ############################################################################## =head3 lib_dir my $lib_dir = $uuid->lib_dir; Returns the OSSP UUID library directory path. App::Info::Lib::OSSPUUID gathers the path from the system call C<`uuid-config --libdir`>. B =over 4 =item info Executing `uuid-config --libdir` =item error Cannot find library directory =item unknown Enter a valid OSSP UUID library directory =back =cut sub lib_dir { my $self = shift; return unless $self->{uuid_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 => 'OSSP UUID library dir', callback => $is_dir ); } } return $self->{lib_dir}; } ############################################################################## =head3 so_lib_dir my $so_lib_dir = $uuid->so_lib_dir; Returns the OSSP UUID shared object library directory path. This is actually just an alias for C. B =over 4 =item info Executing `uuid-config --libdir` =item error Cannot find library directory =item unknown Enter a valid OSSP UUID library directory =back =cut *so_lib_dir = \&lib_dir; ############################################################################## =head3 cflags my $configure = $uuid->cflags; Returns the C flags used when compiling the OSSP UUID library. App::Info::Lib::OSSPUUID gathers the configure data from the system call C<`uuid-config --cflags`>. B =over 4 =item info Executing `uuid-config --configure` =item error Cannot find configure information =item unknown Enter OSSP UUID configuration options =back =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 my $configure = $uuid->ldflags; Returns the LD flags used when compiling the OSSP UUID library. App::Info::Lib::OSSPUUID gathers the configure data from the system call C<`uuid-config --ldflags`>. B =over 4 =item info Executing `uuid-config --configure` =item error Cannot find configure information =item unknown Enter OSSP UUID configuration options =back =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 my $bool = $uuid->perl_module; Return true if C is installed and can be loaded, and false if not. C must be able to be loaded by the currently running instance of the Perl interpreter. B =over 4 =item info Loading OSSP::uuid =back =cut sub perl_module { my $self = shift; $self->info('Loading OSSP::uuuid'); $self->{perl_module} ||= do { eval 'use OSSP::uuid'; $INC{catfile qw(OSSP uuid.pm)}; }; return $self->{perl_module}; } ############################################################################## =head3 home_url my $home_url = $uuid->home_url; Returns the OSSP UUID home page URL. =cut sub home_url { 'http://www.ossp.org/pkg/lib/uuid/' } ############################################################################## =head3 download_url my $download_url = $uuid->download_url; Returns the OSSP UUID download URL. =cut sub download_url { 'http://www.ossp.org/pkg/lib/uuid/' } ############################################################################## =head3 search_exe_names my @search_exe_names = $app->search_exe_names; Returns a list of possible names for F executable. By default, only F is returned (or F on Win32). Note that this method is not used to search for the OSSP UUID server executable, only F. =cut sub search_exe_names { my $self = shift; my $exe = 'uuid-config'; $exe .= '.exe' if WIN32; return ($self->SUPER::search_exe_names, $exe); } ############################################################################## =head3 search_bin_dirs my @search_bin_dirs = $app->search_bin_dirs; Returns a list of possible directories in which to search an executable. Used by the C constructor to find an executable to execute and collect application info. The found directory will also be returned by the C method. The list of directories by default consists of the path as defined by C<< File::Spec->path >>, as well as the following directories: =over 4 =item /usr/local/bin =item /usr/local/sbin =item /usr/bin =item /usr/sbin =item /bin =item C:\Program Files\uid\bin =back =cut sub search_bin_dirs { return shift->SUPER::search_bin_dirs, $u->path, qw(/usr/local/bin /usr/local/sbin /usr/bin /usr/sbin /bin), 'C:\Program Files\uid\bin'; } ############################################################################## =head2 Other Executable Methods These methods function just like the C method, except that they return different executables. OSSP UUID comes with a fair number of them; we provide these methods to provide a path to a subset of them. Each method, when called, checks for an executable in the directory returned by C. The name of the executable must be one of the names returned by the corresponding C method. The available executable methods are: =over =item uuid =item uuid_config =back And the corresponding search names methods are: =over =item search_postgres_names =item search_createdb_names =back B =over 4 =item info Looking for executable =item confirm Path to executable? =item unknown Path to executable? =back =cut sub search_uuid_names { @{ shift->{search_uuid_names} } } 1; __END__ =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler . =head1 SEE ALSO L documents the event handling interface. L is the App::Info::Lib::Expat parent class. L is the Perl interface to the OSSP UUID library. L is the OSSP UUID home page. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/RDBMS000755000765000024 011577311664 15474 5ustar00davidstaff000000000000App-Info-0.57/lib/App/Info/RDBMS/PostgreSQL.pm000444000765000024 6063711577311664 20226 0ustar00davidstaff000000000000package App::Info::RDBMS::PostgreSQL; =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 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 meta data. 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, C, C, C, and C, 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.57'; use constant WIN32 => $^O eq 'MSWin32'; my $u = App::Info::Util->new; my @EXES = qw(postgres createdb createlang createuser dropdb droplang dropuser initdb pg_dump pg_dumpall pg_restore postmaster vacuumdb psql); =head1 INTERFACE =head2 Constructor =head3 new my $pg = App::Info::RDBMS::PostgreSQL->new(@params); Returns an App::Info::RDBMS::PostgreSQL object. See L for a complete description of argument parameters. When it called, C searches the file system for an executable named for the list returned by C, usually F, in the list of directories returned by C. If found, F will be called by the object methods below to gather the data necessary for each. If F cannot be found, then PostgreSQL is assumed not to be installed, and each of the object methods will return C. C also takes a number of optional parameters in addition to those documented for App::Info. These parameters allow you to specify alternate names for PostgreSQL executables (other than F, which you specify via the C parameter). These parameters are: =over =item search_postgres_names =item search_createdb_names =item search_createlang_names =item search_createuser_names =item search_dropd_names =item search_droplang_names =item search_dropuser_names =item search_initdb_names =item search_pg_dump_names =item search_pg_dumpall_names =item search_pg_restore_names =item search_postmaster_names =item search_psql_names =item search_vacuumdb_names =back B =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 = $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 { $self->{$attr} = []; } } 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(qq{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 application on the file system as found when C 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 =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) { # Beta/devel/release candidates are treated as patch level "0" @{$self}{qw(version major minor patch)} = ($version, $x, $y, $z); } elsif ($version =~ /(\d+)\.(\d+)/) { # New versions, such as "7.4", are treated as patch level "0" @{$self}{qw(version major minor patch)} = ($version, $1, $2, 0); } 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 => 'postgres 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 =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 => 'postgres 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, if C returns "7.1.2", then this method returns "7". B =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 => 'postgres 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 returns "7.1.2", then this method returns "2". B =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 => 'postgres 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 returns "7.1.2", then this method returns "1". B =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 => 'postgres patch version number', callback => $is_int) unless defined $self->{patch}; return $self->{patch}; } ############################################################################## =head3 executable my $exe = $pg->executable; Returns the full path to the PostgreSQL server executable, which is named F. This method does not use the executable names returned by C; those executable names are used to search for F only (in C). When it called, C checks for an executable named F in the directory returned by C. Note that C is simply an alias for C. B =over 4 =item info Looking for postgres executable =item confirm Path to postgres executable? =item unknown Path to postgres executable? =back =cut my $find_exe = sub { my ($self, $key) = @_; my $exe = $key . (WIN32 ? '.exe' : ''); my $meth = "search_$key\_names"; # 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) { no strict 'refs'; *{$exe} = sub { shift->$find_exe($exe) }; *{"search_$exe\_names"} = sub { @{ shift->{"search_$exe\_names"} } } } *executable = \&postgres; ############################################################################## =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 =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 => 'postgres bin dir', 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 =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 => 'postgres include dir', 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 =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 => 'postgres library dir', 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 =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 => 'postgres so directory', callback => $is_dir) } } return $self->{so_lib_dir}; } ############################################################################## =head3 configure options my $configure = $pg->configure; Returns the options with which the PostgreSQL server was configured. App::Info::RDBMS::PostgreSQL gathers the configure data from the system call C<`pg_config --configure`>. B =over 4 =item info Executing `pg_config --configure` =item error Cannot find configure information =item unknown Enter PostgreSQL configuration options =back =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 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.postgresql.org/mirrors-ftp.html" } ############################################################################## =head3 search_exe_names my @search_exe_names = $app->search_exe_names; Returns a list of possible names for F executable. By default, only F is returned (or F on Win32). Note that this method is not used to search for the PostgreSQL server executable, only F. =cut sub search_exe_names { my $self = shift; my $exe = 'pg_config'; $exe .= '.exe' if WIN32; return ($self->SUPER::search_exe_names, $exe); } ############################################################################## =head3 search_bin_dirs my @search_bin_dirs = $app->search_bin_dirs; Returns a list of possible directories in which to search an executable. Used by the C constructor to find an executable to execute and collect application info. The found directory will also be returned by the C method. The list of directories by default consists of the path as defined by C<< File::Spec->path >>, as well as the following directories: =over 4 =item $ENV{POSTGRES_HOME}/bin (if $ENV{POSTGRES_HOME} exists) =item $ENV{POSTGRES_LIB}/../bin (if $ENV{POSTGRES_LIB} exists) =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 =item C:\Program Files\PostgreSQL\bin =back =cut sub search_bin_dirs { return shift->SUPER::search_bin_dirs, ( exists $ENV{POSTGRES_HOME} ? ($u->catdir($ENV{POSTGRES_HOME}, "bin")) : () ), ( exists $ENV{POSTGRES_LIB} ? ($u->catdir($ENV{POSTGRES_LIB}, $u->updir, "bin")) : () ), $u->path, qw(/usr/local/pgsql/bin /usr/local/postgres/bin /usr/lib/postgresql/bin /opt/pgsql/bin /usr/local/bin /usr/local/sbin /usr/bin /usr/sbin /bin), 'C:\Program Files\PostgreSQL\bin'; } ############################################################################## =head2 Other Executable Methods These methods function just like the C method, except that they return different executables. PostgreSQL comes with a fair number of them; we provide these methods to provide a path to a subset of them. Each method, when called, checks for an executable in the directory returned by C. The name of the executable must be one of the names returned by the corresponding C method. The available executable methods are: =over =item postgres =item createdb =item createlang =item createuser =item dropdb =item droplang =item dropuser =item initdb =item pg_dump =item pg_dumpall =item pg_restore =item postmaster =item psql =item vacuumdb =back And the corresponding search names methods are: =over =item search_postgres_names =item search_createdb_names =item search_createlang_names =item search_createuser_names =item search_dropd_names =item search_droplang_names =item search_dropuser_names =item search_initdb_names =item search_pg_dump_names =item search_pg_dumpall_names =item search_pg_restore_names =item search_postmaster_names =item search_psql_names =item search_vacuumdb_names =back B =over 4 =item info Looking for executable =item confirm Path to executable? =item unknown Path to executable? =back =cut 1; __END__ =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler based on code by Sam Tregar . =head1 SEE ALSO L documents the event handling interface. L is the App::Info::RDBMS::PostgreSQL parent class. L is the L driver for connecting to PostgreSQL databases. L is the PostgreSQL home page. =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/lib/App/Info/RDBMS/SQLite.pm000444000765000024 5437711577311664 17370 0ustar00davidstaff000000000000package App::Info::RDBMS::SQLite; =head1 NAME App::Info::RDBMS::SQLite - Information about SQLite =head1 SYNOPSIS use App::Info::RDBMS::SQLite; my $sqlite = App::Info::RDBMS::SQLite->new; if ($sqlite->installed) { print "App name: ", $sqlite->name, "\n"; print "Version: ", $sqlite->version, "\n"; print "Bin dir: ", $sqlite->bin_dir, "\n"; } else { print "SQLite is not installed. :-(\n"; } =head1 DESCRIPTION App::Info::RDBMS::SQLite supplies information about the SQLite application 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 for documentation on handling events). To start over (after, say, someone has installed SQLite) construct a new App::Info::RDBMS::SQLite object to aggregate new meta data. 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, C, C, C, and C, 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.57'; use constant WIN32 => $^O eq 'MSWin32'; my $u = App::Info::Util->new; =head1 INTERFACE =head2 Constructor =head3 new my $sqlite = App::Info::RDBMS::SQLite->new(@params); Returns an App::Info::RDBMS::SQLite object. See L for a complete description of argument parameters. When it called, C searches the directories returned by F for an executable with a name returned by C. If found, it will be called by the object methods below to gather the data necessary for each. If it cannot be found, then C will attempt to load L or L. These DBI drivers have SQLite embedded in them but do not install the application. If these fail, then SQLite is assumed not to be installed, and each of the object methods will return C. B =over 4 =item info Looking for SQLite. =item confirm Path to SQLite executable? =item unknown Path to SQLite executable? =back =cut sub new { # Construct the object. 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 $@; # Looks like DBD::SQLite is installed. Set up a temp database # handle so we can get information from it. 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; $self->{dbh}->disconnect if $self->{dbh}; unlink $self->{dbfile} if $self->{dbfile}; } ############################################################################## =head2 Class Method =head3 key_name my $key_name = App::Info::RDBMS::SQLite->key_name; Returns the unique key name that describes this class. The value returned is the string "SQLite". =cut sub key_name { 'SQLite' } ############################################################################## =head2 Object Methods =head3 installed print "SQLite is ", ($sqlite->installed ? '' : 'not '), "installed.\n"; Returns true if SQLite is installed, and false if it is not. App::Info::RDBMS::SQLite determines whether SQLite is installed based on the presence or absence of the F or F application on the file system as found when C constructed the object. If SQLite does not appear to be installed, then all of the other object methods will return empty values. =cut sub installed { return $_[0]->{executable} || $_[0]->{dbh} ? 1 : undef } ############################################################################## =head3 name my $name = $sqlite->name; Returns the name of the application. App::Info::RDBMS::SQLite simply returns the value returned by C if SQLite is installed, and C if it is not installed. =cut sub name { $_[0]->installed ? $_[0]->key_name : undef } # This code reference is used by 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 $version; if ($self->{executable}) { # Get the version number from the executable. $self->info(qq{Executing `"$self->{executable}" -version`}); $version = `"$self->{executable}" -version`; unless ($version) { $self->error("Failed to find SQLite version with ". "`$self->{executable} -version`"); return; } chomp $version; } elsif ($self->{dbh}) { # Get the version number from the database handle. $self->info('Grabbing version from DBD::SQLite'); $version = $self->{dbh}->{sqlite_version}; unless ($version) { $self->error("Failed to retrieve SQLite version from DBD::SQLite"); return; } } else { # No dice. return; } # Parse the version number. my ($x, $y, $z) = $version =~ /(\d+)\.(\d+).(\d+)/; if (defined $x and defined $y and defined $z) { # Beta/devel/release candidates are treated as patch level "0" @{$self}{qw(version major minor patch)} = ($version, $x, $y, $z); } elsif ($version =~ /(\d+)\.(\d+)/) { # New versions, such as "3.0", are treated as patch level "0" @{$self}{qw(version major minor patch)} = ($version, $1, $2, 0); } else { $self->error("Failed to parse SQLite version parts from " . "string '$version'"); } }; ############################################################################## =head3 version my $version = $sqlite->version; Returns the SQLite version number. App::Info::RDBMS::SQLite parses the version number from the system call C<`sqlite -version`> or retrieves it from DBD::SQLite. B =over 4 =item info Executing `sqlite -version` =item error Failed to find SQLite version with `sqlite -version` Failed to retrieve SQLite version from DBD::SQLite Unable to parse name from string Unable to parse version from string Failed to parse SQLite version parts from string =item unknown Enter a valid SQLite version number =back =cut sub version { my $self = shift; return unless $self->installed; # Get 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 => 'sqlite version number', callback => $chk_version); } return $self->{version}; } ############################################################################## =head3 major version my $major_version = $sqlite->major_version; Returns the SQLite major version number. App::Info::RDBMS::SQLite parses the version number from the system call C<`sqlite -version`> or retrieves it from DBD::SQLite. For example, if C returns "3.0.8", then this method returns "3". B =over 4 =item info Executing `sqlite -version` =item error Failed to find SQLite version with `sqlite -version` Failed to retrieve SQLite version from DBD::SQLite Unable to parse name from string Unable to parse version from string Failed to parse SQLite version parts from string =item unknown Enter a valid SQLite 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->installed; # Load data. $get_version->($self) unless exists $self->{'--version'}; # Handle an unknown value. $self->{major} = $self->unknown( key => 'sqlite major version number', callback => $is_int) unless $self->{major}; return $self->{major}; } ############################################################################## =head3 minor version my $minor_version = $sqlite->minor_version; Returns the SQLite minor version number. App::Info::RDBMS::SQLite parses the version number from the system call C<`sqlite -version`> or retrieves it from DBD::SQLite. For example, if C returns "3.0.8", then this method returns "0". B =over 4 =item info Executing `sqlite -version` =item error Failed to find SQLite version with `sqlite -version` Failed to retrieve SQLite version from DBD::SQLite Unable to parse name from string Unable to parse version from string Failed to parse SQLite version parts from string =item unknown Enter a valid SQLite version number =back =cut sub minor_version { my $self = shift; return unless $self->installed; # Load data. $get_version->($self) unless exists $self->{'--version'}; # Handle an unknown value. $self->{minor} = $self->unknown( key => 'sqlite minor version number', callback => $is_int) unless defined $self->{minor}; return $self->{minor}; } ############################################################################## =head3 patch version my $patch_version = $sqlite->patch_version; Returns the SQLite patch version number. App::Info::RDBMS::SQLite parses the version number from the system call C<`sqlite -version`> or retrieves it from DBD::SQLite. For example, if C returns "3.0.8", then this method returns "8". B =over 4 =item info Executing `sqlite -version` =item error Failed to find SQLite version with `sqlite -version` Failed to retrieve SQLite version from DBD::SQLite Unable to parse name from string Unable to parse version from string Failed to parse SQLite version parts from string =item unknown Enter a valid SQLite version number =back =cut sub patch_version { my $self = shift; return unless $self->installed; # Load data. $get_version->($self) unless exists $self->{'--version'}; # Handle an unknown value. $self->{patch} = $self->unknown( key => 'sqlite patch version number', callback => $is_int) unless defined $self->{patch}; return $self->{patch}; } ############################################################################## =head3 executable my $executable = $sqlite->executable; Returns the path to the SQLite executable, usually F or F, which will be defined by one of the names returned byC. The executable is searched for in C, so there are no events for this method. =cut sub executable { shift->{executable} } ############################################################################## =head3 bin_dir my $bin_dir = $sqlite->bin_dir; Returns the SQLite binary directory path. App::Info::RDBMS::SQLite simply retrieves it as the directory part of the path to the SQLite executable. =cut sub bin_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{bin_dir} ) { my @parts = $u->splitpath($self->{executable}); $self->{bin_dir} = $u->catdir( ($parts[0] eq '' ? () : $parts[0]), $u->splitdir($parts[1]) ); } return $self->{bin_dir}; } ############################################################################## =head3 lib_dir my $lib_dir = $expat->lib_dir; Returns the directory path in which an SQLite library was found. The directory path will be one of the values returned by C, where a file with a name as returned by C was found. No search is performed if SQLite is not installed or if only DBD::SQLite is installed. B =over 4 =item info Searching for shared object library directory =item error Cannot find shared object library directory =item unknown Enter a valid Expat shared object library directory =back =cut my $lib_dir = sub { my ($self, $key, $label) = (shift, shift, shift); return unless $self->{executable}; $self->info("Searching for $label directory"); my $dir; unless ($dir = $u->first_cat_dir(\@_, $self->search_lib_dirs)) { $self->error("Cannot find $label directory"); $dir = $self->unknown( key => "sqlite $key dir", callback => sub { $u->first_cat_dir(\@_, $_) }, error => "No $label found in directory " ); } return $dir; }; sub lib_dir { my $self = shift; return unless $self->{executable}; $self->{lib_dir} = $self->$lib_dir('lib', 'library', $self->search_lib_names) unless exists $self->{lib_dir}; return $self->{lib_dir}; } ############################################################################## =head3 so_lib_dir my $so_lib_dir = $expat->so_lib_dir; Returns the directory path in which an SQLite shared object library was found. The directory path will be one of the values returned by C, where a file with a name as returned by C was found. No search is performed if SQLite is not installed or if only DBD::SQLite is installed. B =over 4 =item info Searching for shared object library directory =item error Cannot find shared object library directory =item unknown Enter a valid Expat shared object library directory =back =cut sub so_lib_dir { my $self = shift; return unless $self->{executable}; $self->{so_lib_dir} = $self->$lib_dir('so', 'shared object library', $self->search_so_lib_names) unless exists $self->{so_lib_dir}; return $self->{so_lib_dir}; } ############################################################################## =head3 inc_dir my $inc_dir = $sqlite->inc_dir; Returns the directory path in which an SQLite include file was found. The directory path will be one of the values returned by C, where a file with a name as returned by C was found. No search is performed if SQLite is not installed or if only DBD::SQLite is installed. B =over 4 =item info Searching for include directory =item error Cannot find include directory =item unknown Enter a valid SQLite include directory =back =cut sub inc_dir { my $self = shift; return unless $self->{executable}; unless (exists $self->{inc_dir}) { $self->info("Searching for include directory"); # Should there be more paths than this? my @incs = $self->search_inc_names; if (my $dir = $u->first_cat_dir(\@incs, $self->search_inc_dirs)) { $self->{inc_dir} = $dir; } else { $self->error("Cannot find include directory"); $self->{inc_dir} = $self->unknown( key => 'sqlite inc dir', callback => sub { $u->first_cat_dir(\@incs, $_) }, error => "File 'sqlite.h' not found in directory" ); } } return $self->{inc_dir}; } ############################################################################## =head3 home_url my $home_url = $pg->home_url; Returns the PostgreSQL home page URL. =cut sub home_url { "http://www.sqlite.org/" } ############################################################################## =head3 download_url my $download_url = $pg->download_url; Returns the PostgreSQL download URL. =cut sub download_url { "http://www.sqlite.org/download.html" } ############################################################################## =head3 search_exe_names my @search_exe_names = $sqlite->search_exe_names; Returns a list of possible names for the SQLite executable. The names are F and F by default (F and F on Win32). =cut sub search_exe_names { my $self = shift; my @exes = qw(sqlite3 sqlite); if (WIN32) { $_ .= ".exe" for @exes } return ($self->SUPER::search_exe_names, @exes); } ############################################################################## =head3 search_bin_dirs my @search_bin_dirs = $sqlite->search_bin_dirs; Returns a list of possible directories in which to search an executable. Used by the C constructor to find an executable to execute and collect application info. The found directory will also be returned by the C method. =cut sub search_bin_dirs { (shift->SUPER::search_bin_dirs, $u->path) } ############################################################################## =head3 search_lib_names my @seach_lib_names = $self->search_lib_nams Returns a list of possible names for library files. Used by C to search for library files. By default, the list is: =over =item libsqlite3.a =item libsqlite3.la =item libsqlite3.so =item libsqlite3.so.0 =item libsqlite3.so.0.0.1 =item libsqlite3.dylib =item libsqlite3.0.dylib =item libsqlite3.0.0.1.dylib =item libsqlite.a =item libsqlite.la =item libsqlite.so =item libsqlite.so.0 =item libsqlite.so.0.0.1 =item libsqlite.dylib =item libsqlite.0.dylib =item libsqlite.0.0.1.dylib =back =cut sub search_lib_names { my $self = shift; (my $exe = $u->splitpath($self->{executable})) =~ s/\.[^.]+$//; return $self->SUPER::search_lib_names, map { "lib$exe.$_"} qw(a la so so.0 so.0.0.1 dylib 0.dylib 0.0.1.dylib); } ############################################################################## =head3 search_so_lib_names my @seach_so_lib_names = $self->search_so_lib_nams Returns a list of possible names for shared object library files. Used by C to search for library files. By default, the list is: =over =item libsqlite3.so =item libsqlite3.so.0 =item libsqlite3.so.0.0.1 =item libsqlite3.dylib =item libsqlite3.0.dylib =item libsqlite3.0.0.1.dylib =item libsqlite.so =item libsqlite.so.0 =item libsqlite.so.0.0.1 =item libsqlite.dylib =item libsqlite.0.dylib =item libsqlite.0.0.1.dylib =back =cut sub search_so_lib_names { my $self = shift; (my $exe = $u->splitpath($self->{executable})) =~ s/\.[^.]+$//; return $self->SUPER::search_so_lib_names, map { "lib$exe.$_"} qw(so so.0 so.0.0.1 dylib 0.dylib 0.0.1.dylib); } ############################################################################## =head3 search_lib_dirs my @search_lib_dirs = $sqlite->search_lib_dirs; Returns a list of possible directories in which to search for libraries. By default, it returns all of the paths in the C and C attributes defined by the Perl L module -- plus F (in support of all you Fink users out there). =cut sub search_lib_dirs { shift->SUPER::search_lib_dirs, $u->lib_dirs, '/sw/lib' } ############################################################################## =head3 search_inc_names my @search_inc_names = $sqlite->search_inc_names; Returns a list of include file names to search for. Used by C to search for an include file. By default, the names are F and F. =cut sub search_inc_names { my $self = shift; (my $exe = $u->splitpath($self->{executable})) =~ s/\.[^.]+$//; return $self->SUPER::search_inc_names, "$exe.h"; } ############################################################################## =head3 search_inc_dirs my @search_inc_dirs = $sqlite->search_inc_dirs; Returns a list of possible directories in which to search for include files. Used by C to search for an include file. By default, the directories are: =over 4 =item /usr/local/include =item /usr/include =item /sw/include =back =cut sub search_inc_dirs { shift->SUPER::search_inc_dirs, qw(/usr/local/include /usr/include /sw/include); } 1; __END__ =head1 SUPPORT This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 AUTHOR David E. Wheeler =head1 SEE ALSO L documents the event handling interface. L is the App::Info::RDBMS parent class from which App::Info::RDBMS::SQLite inherits. L is the L driver for connecting to SQLite databases. L is the SQLite home page. =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2011, David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut App-Info-0.57/t000755000765000024 011577311664 12707 5ustar00davidstaff000000000000App-Info-0.57/t/apache.t000444000765000024 550111577311664 14453 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 33; use File::Spec::Functions; BEGIN { use_ok('App::Info::HTTPD::Apache') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; my $conf_dir = catdir 't', 'testlib'; my $inc_dir = catdir 't', 'testinc'; # Win32 Thinks the bin directory is the root. my $httpd_root = $^O eq 'MSWin32' ? $bin_dir : 't'; my %exes = ( map { $_ => catfile $bin_dir, "$_$ext" } qw(httpd myapxs) ); my @mods = qw(http_core mod_env mod_log_config mod_mime mod_negotiation mod_status mod_include mod_autoindex mod_dir mod_cgi mod_asis mod_imap mod_actions mod_userdir mod_alias mod_rewrite mod_access mod_auth mod_so mod_setenvif mod_ssl mod_perl); ok( my $apache = App::Info::HTTPD::Apache->new( search_bin_dirs => $bin_dir, search_exe_names => "httpd$ext", search_apxs_names => "myapxs$ext", search_conf_dirs => $conf_dir, search_lib_dirs => $conf_dir, search_inc_dirs => $inc_dir, ), "Got Object"); isa_ok($apache, 'App::Info::HTTPD::Apache'); isa_ok($apache, 'App::Info'); is( $apache->key_name, 'Apache', "Check key name" ); ok( $apache->installed, "Apache is installed" ); is( $apache->name, "Apache", "Get name" ); is( $apache->version, "1.3.31", "Test Version" ); is( $apache->major_version, '1', "Test major version" ); is( $apache->minor_version, '3', "Test minor version" ); is( $apache->patch_version, '31', "Test patch version" ); is( $apache->httpd_root, $httpd_root, "Test httpd root" ); ok( $apache->mod_perl, "Test mod_perl" ); is( $apache->conf_file, catfile(qw(t testlib httpd.conf)), "Test conf file" ); is( $apache->user, "nobody", "Test user" ); is( $apache->group, "nobody", "Test group" ); is( $apache->compile_option('DEFAULT_ERRORLOG'), 'logs/error_log', "Check error log from compile_option()" ); is( $apache->lib_dir, $conf_dir, "Test lib dir" ); is( $apache->bin_dir, $bin_dir, "Test bin dir" ); is( $apache->executable, $exes{httpd}, "Test executable" ); is( $apache->httpd, $exes{httpd}, "Test httpd" ); is( $apache->apxs, $exes{myapxs}, "Test apxs" ); is( $apache->so_lib_dir, $conf_dir, "Test so lib dir" ); is( $apache->inc_dir, $inc_dir, "Test inc dir" ); ok( eq_set( scalar $apache->static_mods, \@mods, ), "Check static mods" ); is( $apache->magic_number, '19990320:16', "Test magic number" ); is( $apache->port, '80', "Test port" ); is( $apache->doc_root, '/test/doc/root', 'Test doc_root' ); is( $apache->cgibin_virtual, '/test/cgi-bin/', 'Test cgibin_virtual'); is( $apache->cgibin_physical, '/this/is/a/test/cgi-bin/', 'Test cgibin_physical'); ok( $apache->mod_so, "Test mod_so" ); is( $apache->home_url, 'http://httpd.apache.org/', "Get home URL" ); is( $apache->download_url, 'http://www.apache.org/dist/httpd/', "Get download URL" ); App-Info-0.57/t/apache2.t000444000765000024 533511577311664 14542 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 32; use File::Spec::Functions; BEGIN { use_ok('App::Info::HTTPD::Apache') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; my $conf_dir = catdir 't', 'testlib'; my $inc_dir = catdir 't', 'testinc'; # Win32 Thinks the bin directory is the root. my $httpd_root = $^O eq 'MSWin32' ? $bin_dir : 't'; my %exes = ( map { $_ => catfile $bin_dir, "$_$ext" } qw(httpd2 myapxs) ); my @mods = qw(core mod_access mod_auth mod_log_config mod_setenvif prefork http_core mod_mime mod_status mod_autoindex mod_asis mod_cgi mod_negotiation mod_dir mod_imap mod_actions mod_userdir mod_alias mod_so); my @so_mods = qw(mod_dir mod_include mod_perl); ok( my $apache = App::Info::HTTPD::Apache->new( search_bin_dirs => $bin_dir, search_exe_names => "httpd2$ext", search_apxs_names => "myapxs$ext", search_conf_dirs => $conf_dir, search_lib_dirs => $conf_dir, search_inc_dirs => $inc_dir, ), "Got Object"); isa_ok($apache, 'App::Info::HTTPD::Apache'); isa_ok($apache, 'App::Info'); is( $apache->key_name, 'Apache', 'Check key name' ); ok( $apache->installed, 'Apache is installed' ); is( $apache->name, 'Apache', 'Get name' ); is( $apache->version, '2.0.55', 'Test Version' ); is( $apache->major_version, '2', 'Test major version' ); is( $apache->minor_version, '0', 'Test minor version' ); is( $apache->patch_version, '55', 'Test patch version' ); is( $apache->httpd_root, $httpd_root, 'Test httpd root' ); ok( $apache->mod_perl, 'Test mod_perl' ); is( $apache->conf_file, catfile(qw(t testlib httpd.conf)), 'Test conf file' ); is( $apache->user, 'nobody', 'Test user' ); is( $apache->group, 'nobody', 'Test group' ); is( $apache->compile_option('DEFAULT_ERRORLOG'), 'logs/error_log', 'Check error log from compile_option()' ); is( $apache->lib_dir, $conf_dir, 'Test lib dir' ); is( $apache->bin_dir, $bin_dir, 'Test bin dir' ); is( $apache->executable, $exes{httpd2}, 'Test executable' ); is( $apache->httpd, $exes{httpd2}, 'Test httpd' ); is( $apache->apxs, $exes{myapxs}, 'Test apxs' ); is( $apache->so_lib_dir, $conf_dir, 'Test so lib dir' ); is( $apache->inc_dir, $inc_dir, 'Test inc dir' ); is_deeply( scalar $apache->static_mods, \@mods, 'Check static mods' ); is_deeply( [ sort $apache->shared_mods ], \@so_mods, 'Check so mods' ); is( $apache->magic_number, '20020903:11', 'Test magic number' ); is( $apache->port, '80', 'Test port' ); is( $apache->doc_root, '/test/doc/root', 'Test doc_root' ); ok( $apache->mod_so, 'Test mod_so' ); is( $apache->home_url, 'http://httpd.apache.org/', 'Get home URL' ); is( $apache->download_url, 'http://www.apache.org/dist/httpd/', 'Get download URL' ); App-Info-0.57/t/apache_info.t000444000765000024 2402711577311664 15512 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 79; use lib 't/lib'; use File::Spec::Functions; use EventTest; ############################################################################## BEGIN { use_ok('App::Info::HTTPD::Apache') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $scripts = 'scripts'; my $bin_dir = catdir 't', $scripts; my $conf_dir = catdir 't', 'testlib'; my $inc_dir = catdir 't', 'testinc'; # Win32 Thinks the bin directory is the root. my $httpd_root = $^O eq 'MSWin32' ? $bin_dir : 't'; unless (-d $bin_dir) { $bin_dir = catdir 't', 'bin'; $scripts = 'bin'; } my @params = ( search_bin_dirs => $bin_dir, search_exe_names => "httpd$ext", search_apxs_names => "myapxs$ext", search_conf_dirs => $conf_dir, search_lib_dirs => $conf_dir, search_inc_dirs => $inc_dir, ); # Test info events. ok( my $info = EventTest->new, "Create info EventTest" ); ok( my $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object"); is( $info->message, "Looking for Apache executable", "Check constructor info" ); ########################################################################## # Check name. $apache->name; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -v`$/, "Check name info" ); $apache->name; ok( ! defined $info->message, "No info" ); $apache->version; ok( ! defined $info->message, "Still No info" ); ########################################################################## # Check version. ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 2"); $info->message; # Throw away constructor message. $apache->version; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -v`$/, "Check version info" ); $apache->version; ok( ! defined $info->message, "No info" ); $apache->major_version; ok( ! defined $info->message, "Still No info" ); ########################################################################## # Check major version. ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 3"); $info->message; # Throw away constructor message. $apache->major_version; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -v`$/, "Check major info" ); ########################################################################## # Check minor version. ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 4"); $info->message; # Throw away constructor message. $apache->minor_version; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -v`$/, "Check minor info" ); ########################################################################## # Check patch version. ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 5"); $info->message; # Throw away constructor message. $apache->patch_version; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -v`$/, "Check patch info" ); ########################################################################## # Check inc_dir method. $apache->inc_dir; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check inc_dir info" ); is( $info->message, "Searching for include directory", "Check inc info again" ); ok( ! defined $info->message, "No more inc info" ); $apache->inc_dir; ok( ! defined $info->message, "Still no more inc info" ); # Try again with a new object. ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 7"); $info->message; # Throw away constructor message. $apache->inc_dir; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check inc info new" ); is( $info->message, "Searching for include directory", "Check inc info again" ); ok( ! defined $info->message, "No more inc new info" ); ########################################################################## # Check lib_dir method. $apache->lib_dir; is( $info->message, "Searching for library directory", "Check lib info again" ); ok( ! defined $info->message, "No more lib info" ); $apache->lib_dir; ok( ! defined $info->message, "Still no more lib info" ); # Try again with a new object. ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 8"); $info->message; # Throw away constructor message. $apache->lib_dir; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check lib info new" ); is( $info->message, "Searching for library directory", "Check lib info again" ); ok( ! defined $info->message, "No more lib new info" ); ########################################################################## # Test httpd_root(). ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 9"); $info->message; # Throw away constructor message. $apache->httpd_root; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check httpd_root info" ); ok( ! defined $info->message, "No more httpd_root info" ); $apache->httpd_root; ok( ! defined $info->message, "Still no httpd_root info" ); ########################################################################## # Test magic_number(). $apache->magic_number; ok( ! defined $info->message, "No magic_number info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 10"); $info->message; # Throw away constructor message. $apache->magic_number; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check magic_number info" ); ok( ! defined $info->message, "No more magic_number info" ); ########################################################################## # Test compile_option(). $apache->compile_option('foo'); ok( ! defined $info->message, "No compile_option info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 10"); $info->message; # Throw away constructor message. $apache->compile_option('foo'); like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check compile_option info" ); ok( ! defined $info->message, "No more compile_option info" ); ########################################################################## # Test conf_file(). $apache->conf_file; is( $info->message, "Searching for Apache configuration file", "Check conf_file info" ); ok( ! defined $info->message, "No more conf_file info" ); $apache->conf_file; ok( ! defined $info->message, "Still no more conf_file info" ); ########################################################################## # Test user(). $apache->user; is( $info->message, "Parsing Apache configuration file", "Check user info" ); ok( ! defined $info->message, "No more user info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 11"); $info->message; # Throw away constructor message. $apache->user; is( $info->message, "Searching for Apache configuration file", "Check user info 2" ); like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check user info 3" ); is( $info->message, "Parsing Apache configuration file", "Check user info 4" ); ok( ! defined $info->message, "No more user info" ); ########################################################################## # Test group(). $apache->group; ok( ! defined $info->message, "No group info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 11"); $info->message; # Throw away constructor message. $apache->group; is( $info->message, "Searching for Apache configuration file", "Check group info 2" ); like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check group info 3" ); is( $info->message, "Parsing Apache configuration file", "Check group info 4" ); ok( ! defined $info->message, "No more group info" ); ########################################################################## # Test port(). $apache->port; ok( ! defined $info->message, "No port info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 11"); $info->message; # Throw away constructor message. $apache->port; is( $info->message, "Searching for Apache configuration file", "Check port info 2" ); like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -V`$/, "Check port info 3" ); is( $info->message, "Parsing Apache configuration file", "Check port info 4" ); ok( ! defined $info->message, "No more port info" ); ########################################################################## # Tests static_mods(). $apache->static_mods; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -l`$/, "Check static_mods info" ); ok( ! defined $info->message, "No more static_mods info" ); ########################################################################## # Tests shared_mods(). $apache->shared_mods; is( $info->message, 'Looking for apxs', 'Shared modes should look for apxs' ); like( $info->message, qr/^Executing `"t.$scripts.myapxs(?:.bat)?" -q LIBEXECDIR`$/, "Check shared_mods info" ); ok( ! defined $info->message, "No more shared_mods info" ); ########################################################################## # Tests mod_so(). $apache->mod_so; ok( ! defined $info->message, "No mod_so info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 12"); $info->message; # Throw away constructor message. $apache->mod_so; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -l`$/, "Check mod_so info" ); ok( ! defined $info->message, "No more mod_so info" ); ########################################################################## # Tests mod_perl(). $apache->mod_perl; ok( ! defined $info->message, "No mod_perl info" ); ok( $apache = App::Info::HTTPD::Apache->new( @params, on_info => $info ), "Got Object 13"); $info->message; # Throw away constructor message. $apache->mod_perl; like($info->message, qr/^Executing `"t.$scripts.httpd(?:.bat)?" -l`$/, "Check mod_perl info" ); ok( ! defined $info->message, "No more mod_perl info" ); __END__ App-Info-0.57/t/carp.t000444000765000024 462711577311664 14167 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 23; my $msg = "Error retrieving version"; # Set up an App::Info subclass to ruin. package App::Info::Category::FooApp; use App::Info; use File::Spec; use strict; use vars qw(@ISA); @ISA = qw(App::Info); sub version { shift->error($msg) } (my $fn = File::Spec->catfile('t', 'carp.t')) =~ s/\\/\\\\/g; package main; BEGIN { use_ok('App::Info::Handler::Carp') } # Try confess first. ok( my $app = App::Info::Category::FooApp->new( on_error => 'confess'), "Set up for confess" ); eval { $app->version }; ok( my $err = $@, "Get confess" ); like( $err, qr/^Error retrieving version/, "Starts with confess message" ); like( $err, qr/called (?:at\s+$fn|$fn\s+at)\s+line/, "Confess has stack trace" ); # Now try croak. ok( $app = App::Info::Category::FooApp->new( on_error => 'croak'), "Set up for croak" ); eval { $app->version }; ok( $err = $@, "Get croak" ); like( $err, qr/^Error retrieving version at.*$fn/, "Starts with croak message" ); unlike( $err, qr/called (?:at\s+$fn|$fn\s+at)\s+line/, "Croak has no stack trace" ); # Now die. ok( $app = App::Info::Category::FooApp->new( on_error => 'die'), "Set up for die" ); eval { $app->version }; ok( $err = $@, "Get die" ); like( $err, qr/^Error retrieving version/, "Starts with die message" ); unlike( $err, qr/called (?:at\s+$fn|$fn\s+at)\s+line/, "Die has no stack trace" ); # Set up to capture warnings. $SIG{__WARN__} = sub { $err = shift }; # Cluck. ok( $app = App::Info::Category::FooApp->new( on_error => 'cluck'), "Set up for cluck" ); $app->version; like( $err, qr/^Error retrieving version/, "Starts with cluck message" ); like( $err, qr/called (?:at\s+$fn|$fn\s+at)\s+line/, "Cluck as stack trace" ); # Carp. ok( $app = App::Info::Category::FooApp->new( on_error => 'carp'), "Set up for carp" ); $app->version; like( $err, qr/^Error retrieving version/, "Starts with carp message" ); unlike( $err, qr/called (?:at\s+$fn|$fn\s+at)\s+line/, "Carp has no stack trace" ); # Warn. ok( $app = App::Info::Category::FooApp->new( on_error => 'warn'), "Set up for warn" ); $app->version; like( $err, qr/^Error retrieving version/, "Starts with warn message" ); unlike( $err, qr/called (?:at\s+$fn|$fn\s+at)\s+line/, "Warn has no stack trace" ); # Dissallow bogus error levels. eval { App::Info::Category::FooApp->new( on_error => 'bogus') }; like( $@, qr/No such handler 'bogus'/, "Check for bogus error level" ); App-Info-0.57/t/confirm.t000555000765000024 647411577311664 14704 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use File::Spec::Functions qw(tmpdir); use Test::More tests => 14; ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { 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. ############################################################################## # Set up a couple of answers. print STDIN "foo3424324\n"; print STDIN "\n"; ok( App::Info::HTTPD::Apache->new( on_confirm => $p, on_unknown => $p ), "Set up for Apache confirm" ); my $expected = qr/Path to your httpd executable?.* Not an executable: 'foo3424324'\nPath to your httpd executable?/; like ($stdout->read, $expected, "Check Apache cofirm" ); ############################################################################## # Test PostgreSQL. ############################################################################## # Set up a couple of answers. print STDIN "foo3424324\n"; print STDIN "\n"; ok( App::Info::RDBMS::PostgreSQL->new( on_confirm => $p, on_unknown => $p ), "Set up for Pg confirm" ); $expected = qr/Path to pg_config?.* Not an executable: 'foo3424324'\nPath to pg_config?/; like ($stdout->read, $expected, "Check Pg cofirm" ); ############################################################################## # Test Expat. ############################################################################## # Set up a couple of answers. print STDIN "foo3424324\n"; print STDIN "\n"; ok( App::Info::Lib::Expat->new( on_confirm => $p, on_unknown => $p ), "Set up for Expat confirm" ); $expected = qr/Path to Expat library directory?.* No Expat libraries found in directory: 'foo3424324'\nPath to Expat library directory?/; like ($stdout->read, $expected, "Check Expat cofirm" ); ############################################################################## # Test Iconv. ############################################################################## # Set up a couple of answers. print STDIN "foo3424324\n"; print STDIN "\n"; ok( App::Info::Lib::Iconv->new( on_confirm => $p, on_unknown => $p ), "Set up for Iconv confirm" ); $expected = qr/Path to iconv executable?.* Not an executable: 'foo3424324'\nPath to iconv executable?/; like ($stdout->read, $expected, "Check Iconv cofirm" ); __END__ App-Info-0.57/t/errors.t000555000765000024 50211577311664 14525 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 3; BEGIN { use_ok 'App::Info' or die; } eval { App::Info->key_name }; ok my $err = $@, "Yes! Caught exception"; like $err, qr'App::Info is an abstract base class. Attempt to call non-existent method App::Info::key_name', "and it's the right exception"; App-Info-0.57/t/expat.t000444000765000024 234711577311664 14360 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 20; use File::Spec::Functions; BEGIN { use_ok('App::Info::Lib::Expat') } my $lib_dir = catdir 't', 'testlib'; my $inc_dir = catdir 't', 'testinc'; ok( my $expat = App::Info::Lib::Expat->new( search_lib_dirs => $lib_dir, search_inc_dirs => $inc_dir, ), "Got Object"); isa_ok($expat, 'App::Info::Lib::Expat'); isa_ok($expat, 'App::Info::Lib'); isa_ok($expat, 'App::Info'); ok( $expat->name, "Got name" ); is( $expat->key_name, 'Expat', "Check key name" ); ok( $expat->installed, "libexpat is installed" ); is( $expat->name, "Expat", "Get name" ); is( $expat->version, "1.95.8", "Test Version" ); is( $expat->major_version, '1', "Test major version" ); is( $expat->minor_version, '95', "Test minor version" ); is( $expat->patch_version, '8', "Test patch version" ); is( $expat->lib_dir, $lib_dir, "Test lib dir" ); ok( ! defined $expat->bin_dir, "Test bin dir" ); ok( ! defined $expat->executable, "Test executable" ); is( $expat->so_lib_dir, $lib_dir, "Test so lib dir" ); is( $expat->inc_dir, $inc_dir, "Test inc dir" ); is( $expat->home_url, 'http://expat.sourceforge.net/', "Get home URL" ); is( $expat->download_url, 'http://sourceforge.net/projects/expat/', "Get download URL" ); App-Info-0.57/t/expat_info.t000444000765000024 545711577311664 15400 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 22; use constant SKIP => 18; ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib', 'lib'; } } chdir 't'; use EventTest; ############################################################################## BEGIN { use_ok('App::Info::Lib::Expat') } # Test info events. ok( my $info = EventTest->new, "Create info EventTest" ); ok( my $expat = App::Info::Lib::Expat->new( on_info => $info ), "Got Object"); is( $info->message, "Searching for Expat libraries", "Check constructor info" ); SKIP: { # Skip tests? skip "Expat not installed", SKIP unless $expat->installed; # Check version. $expat->version; is( $info->message, "Searching for 'expat.h'", "Check version info" ); is( $info->message, "Searching for include directory", "Check version info again" ); $expat->version; ok( ! defined $info->message, "No info" ); $expat->major_version; ok( ! defined $info->message, "Still No info" ); # Check major version. ok( $expat = App::Info::Lib::Expat->new( on_info => $info ), "Got Object 2"); $info->message; $expat->major_version; is( $info->message, "Searching for 'expat.h'", "Check major info" ); is( $info->message, "Searching for include directory", "Check major info again" ); # Check minor version. ok( $expat = App::Info::Lib::Expat->new( on_info => $info ), "Got Object 3"); $info->message; # Throw away constructor message. $expat->minor_version; is( $info->message, "Searching for 'expat.h'", "Check minor info" ); is( $info->message, "Searching for include directory", "Check minor info again" ); # Check patch version. ok( $expat = App::Info::Lib::Expat->new( on_info => $info ), "Got Object 4"); $info->message; # Throw away constructor message. $expat->patch_version; is( $info->message, "Searching for 'expat.h'", "Check patch info" ); is( $info->message, "Searching for include directory", "Check patch info again" ); # Check dir methods. ok( $expat = App::Info::Lib::Expat->new( on_info => $info ), "Got Object 5"); $info->message; # Throw away constructor message. $expat->bin_dir; ok( ! defined $info->message, "Check bin info" ); $expat->inc_dir; is( $info->message, "Searching for include directory", "Check inc info" ); $expat->lib_dir; ok( ! defined $info->message, "Check lib info" ); $expat->so_lib_dir; is( $info->message, "Searching for shared object library directory", "Check so lib info" ); } __END__ App-Info-0.57/t/iconv.t000444000765000024 273211577311664 14353 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 19; use File::Spec::Functions; BEGIN { use_ok('App::Info::Lib::Iconv') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $lib_dir = catdir 't', 'testlib'; my $inc_dir = catdir 't', 'testinc'; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; my $executable = catfile $bin_dir, "iconv$ext"; ok( my $iconv = App::Info::Lib::Iconv->new( search_lib_dirs => $lib_dir, search_exe_names => ["iconv$ext"], search_inc_dirs => $inc_dir, search_bin_dirs => $bin_dir, ), "Got Object"); isa_ok($iconv, 'App::Info::Lib::Iconv'); isa_ok($iconv, 'App::Info'); is( $iconv->name, 'libiconv', "Check name" ); is( $iconv->key_name, 'libiconv', "Check key name" ); ok( $iconv->installed, "libiconv is installed" ); is( $iconv->name, "libiconv", "Get name" ); is( $iconv->version, "1.9", "Test Version" ); is( $iconv->major_version, '1', "Test major version" ); is( $iconv->minor_version, '9', "Test minor version" ); ok( ! defined $iconv->patch_version, "Test patch version" ); is( $iconv->lib_dir, $lib_dir, "Test lib dir" ); is( $iconv->bin_dir, $bin_dir, "Test bin dir" ); is( $iconv->executable, $executable, "Test executable" ); is( $iconv->so_lib_dir, $lib_dir, "Test so lib dir" ); is( $iconv->inc_dir, $inc_dir, "Test inc dir" ); is( $iconv->home_url, 'http://www.gnu.org/software/libiconv/', "Get home URL" ); is( $iconv->download_url, 'ftp://ftp.gnu.org/pub/gnu/libiconv/', "Get download URL" ); App-Info-0.57/t/iconv_info.t000444000765000024 474711577311664 15376 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 19; use constant SKIP => 15; ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib', 'lib'; } } chdir 't'; use EventTest; ############################################################################## BEGIN { use_ok('App::Info::Lib::Iconv') } # Test info events. ok( my $info = EventTest->new, "Create info EventTest" ); ok( my $iconv = App::Info::Lib::Iconv->new( on_info => $info ), "Got Object"); is( $info->message, "Searching for iconv", "Check constructor info" ); SKIP: { # Skip tests? skip "libiconv not installed", SKIP unless $iconv->installed; # Check version. $iconv->version; is( $info->message, "Searching for 'iconv.h'", "Check version info" ); is( $info->message, "Searching for include directory", "Check version info again" ); $iconv->version; ok( ! defined $info->message, "No info" ); $iconv->major_version; ok( ! defined $info->message, "Still No info" ); # Check major version. ok( $iconv = App::Info::Lib::Iconv->new( on_info => $info ), "Got Object 2"); $info->message; $iconv->major_version; is( $info->message, "Searching for 'iconv.h'", "Check major info" ); is( $info->message, "Searching for include directory", "Check major info again" ); # Check minor version. ok( $iconv = App::Info::Lib::Iconv->new( on_info => $info ), "Got Object 3"); $info->message; # Throw away constructor message. $iconv->minor_version; is( $info->message, "Searching for 'iconv.h'", "Check minor info" ); is( $info->message, "Searching for include directory", "Check minor info again" ); # Check dir methods. ok( $iconv = App::Info::Lib::Iconv->new( on_info => $info ), "Got Object 4"); $info->message; # Throw away constructor message. $iconv->bin_dir; is( $info->message, "Searching for bin directory", "Check bin info" ); $iconv->inc_dir; is( $info->message, "Searching for include directory", "Check inc info" ); $iconv->lib_dir; is( $info->message, "Searching for library directory", "Check lib info" ); $iconv->so_lib_dir; is( $info->message, "Searching for shared object library directory", "Check so lib info" ); } __END__ App-Info-0.57/t/postgres.t000444000765000024 306411577311664 15102 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 21; use File::Spec::Functions; BEGIN { use_ok('App::Info::RDBMS::PostgreSQL') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; my %exes = ( map { $_ => catfile $bin_dir, "$_$ext" } qw(postgres mycreatedb) ); ok( my $pg = App::Info::RDBMS::PostgreSQL->new( search_bin_dirs => $bin_dir, search_exe_names => "pg_config$ext", search_createdb_names => "mycreatedb$ext", search_postgres_names => "postgres$ext", ), "Got Object"); isa_ok($pg, 'App::Info::RDBMS::PostgreSQL'); isa_ok($pg, 'App::Info'); is( $pg->key_name, 'PostgreSQL', "Check key name" ); ok( $pg->installed, "PostgreSQL is installed" ); is( $pg->name, "PostgreSQL", "Get name" ); is( $pg->version, "8.0.0", "Test Version" ); is( $pg->major_version, '8', "Test major version" ); is( $pg->minor_version, '0', "Test minor version" ); is( $pg->patch_version, '0', "Test patch version" ); is( $pg->lib_dir, 't/testlib', "Test lib dir" ); is( $pg->executable, $exes{postgres}, "Test executable" ); is( $pg->postgres, $exes{postgres}, "Test postgres" ); is( $pg->createdb, $exes{mycreatedb}, "Test createdb" ); is( $pg->bin_dir, $bin_dir, "Test bin dir" ); is( $pg->so_lib_dir, 't/testlib', "Test so lib dir" ); is( $pg->inc_dir, "t/testinc", "Test inc dir" ); is( $pg->configure, '', "Test configure" ); is( $pg->home_url, 'http://www.postgresql.org/', "Get home URL" ); is( $pg->download_url, 'http://www.postgresql.org/mirrors-ftp.html', "Get download URL" ); App-Info-0.57/t/postgres_info.t000444000765000024 622111577311664 16113 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 22; use constant SKIP => 18; ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib', 'lib'; } } chdir 't'; use EventTest; ############################################################################## BEGIN { use_ok('App::Info::RDBMS::PostgreSQL') } # Test info events. ok( my $info = EventTest->new, "Create info EventTest" ); ok( my $pg = App::Info::RDBMS::PostgreSQL->new( on_info => $info ), "Got Object"); is( $info->message, "Looking for pg_config", "Check constructor info" ); SKIP: { # Skip tests? skip "PostgreSQL not installed", SKIP unless $pg->installed; # Check name. $pg->name; like($info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --version`$/, "Check name info" ); $pg->name; ok( ! defined $info->message, "No info" ); $pg->version; ok( ! defined $info->message, "Still No info" ); # Check version. ok( $pg = App::Info::RDBMS::PostgreSQL->new( on_info => $info ), "Got Object 2"); $info->message; # Throw away constructor message. $pg->version; like($info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --version`$/, "Check version info" ); $pg->version; ok( ! defined $info->message, "No info" ); $pg->major_version; ok( ! defined $info->message, "Still No info" ); # Check major version. ok( $pg = App::Info::RDBMS::PostgreSQL->new( on_info => $info ), "Got Object 3"); $info->message; # Throw away constructor message. $pg->major_version; like($info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --version`$/, "Check major info" ); # Check minor version. ok( $pg = App::Info::RDBMS::PostgreSQL->new( on_info => $info ), "Got Object 4"); $info->message; # Throw away constructor message. $pg->minor_version; like($info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --version`$/, "Check minor info" ); # Check patch version. ok( $pg = App::Info::RDBMS::PostgreSQL->new( on_info => $info ), "Got Object 5"); $info->message; # Throw away constructor message. $pg->patch_version; like($info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --version`$/, "Check patch info" ); # Check dir methods. $pg->bin_dir; like( $info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --bindir`$/, "Check bin info" ); $pg->inc_dir; like( $info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --includedir`$/, "Check inc info" ); $pg->lib_dir; like( $info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --libdir`$/, "Check lib info" ); $pg->so_lib_dir; like( $info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --pkglibdir`$/, "Check so lib info" ); $pg->configure; like( $info->message, qr/^Executing `".*pg_config(?:[.]exe)?" --configure`$/, "Check configure info" ); } __END__ App-Info-0.57/t/print.t000444000765000024 630011577311664 14364 0ustar00davidstaff000000000000#!/usr/bin/perl -w # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib', 'lib'; } } chdir 't'; use strict; use Test::More tests => 23; use File::Spec::Functions qw(:ALL); use File::Path; use FileHandle; use TieOut; # This is the message we'll test for. my $msg = "Run away! Run away!"; # Set up an App::Info subclass to ruin. package App::Info::Category::FooApp; use App::Info; use strict; use vars qw(@ISA); @ISA = qw(App::Info); sub version { shift->info($msg) } package main; BEGIN { use_ok('App::Info::Handler::Print') } my $file = catfile tmpdir, 'app-info-print.tst'; # Start by testing the default. my $stderr = tie *STDERR, 'TieOut' or die "Cannot tie STDERR: $!\n"; ok( my $p = App::Info::Handler::Print->new, "Create default" ); ok( my $app = App::Info::Category::FooApp->new( on_info => $p ), "Set up for default" ); $app->version; is ($stderr->read, "$msg\n", "Check default" ); # Now try STDERR, which should be the same thing. ok( $p = App::Info::Handler::Print->new( fh => 'stderr' ), "Create STDERR" ); ok( $app = App::Info::Category::FooApp->new( on_info => $p ), "Set up for STDERR" ); $app->version; is ($stderr->read, "$msg\n", "Check STDERR" ); # Release! undef $stderr; untie *STDERR; # Now test STDOUT. my $stdout = tie *STDOUT, 'TieOut' or die "Cannot tie STDOUT: $!\n"; ok( $p = App::Info::Handler::Print->new( fh => 'stdout' ), "Create STDOUT" ); ok( $app = App::Info::Category::FooApp->new( on_info => $p ), "Set up for STDOUT" ); $app->version; is ($stdout->read, "$msg\n", "Check STDOUT" ); undef $stdout; untie *STDOUT; # Now try STDOUT. # Try a file handle. my $fh = FileHandle->new(">$file"); ok( $p = App::Info::Handler::Print->new( fh => $fh ), "Create with file handle" ); is( ($app->on_info($p))[0], $p, "Set file handle handler" ); is( ($app->on_info)[0], $p, "Make sure the file handle handler is set" ); $app->version; $fh->close; chk_file($file, "Check file handle output", "$msg\n"); # Try appending. $fh = FileHandle->new(">>$file"); ok( $p = App::Info::Handler::Print->new( fh => $fh ), "Create with append" ); is( ($app->on_info($p))[0], $p, "Set append handler" ); is( ($app->on_info)[0], $p, "Make sure the append handler is set" ); $app->version; $fh->close; chk_file($file, "Check append output", "$msg\n$msg\n"); # Try a file handle glob. open F, ">$file" or die "Cannot open $file: $!\n"; ok( $p = App::Info::Handler::Print->new( fh => \*F ), "Create with glob" ); is( ($app->on_info($p))[0], $p, "Set glob handler" ); is( ($app->on_info)[0], $p, "Make sure the glob handler is set" ); $app->version; close F or die "Cannot close $file: $!\n"; chk_file($file, "Check glob output", "$msg\n"); # Try an invalid argument. eval { App::Info::Handler::Print->new( fh => 'foo') }; like( $@, qr/^Invalid argument to new\(\): 'foo'/, "Check invalid argument" ); # Delete the test file. rmtree $file; sub chk_file { my ($file, $tst_name, $val) = @_; open F, "<$file" or die "Cannot open $file: $!\n"; local $/; is(, $val || "$msg\n", $tst_name); close F or die "Cannot close $file: $!\n"; } __END__ App-Info-0.57/t/prompt.t000444000765000024 2012211577311664 14567 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 34; use File::Spec::Functions qw(:ALL); ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib', 'lib'; } } chdir 't'; use TieOut; ############################################################################## # Set up an App::Info subclass to ruin. package App::Info::Category::FooApp; 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 { shift->unknown( key => 'version number', callback => sub { $_[0] =~ /^\d+$/ } ) } sub so_lib_dir { shift->confirm( key => 'shared object directory', value => '/foo33') } sub name { shift->confirm( key => 'name', value => 'ick', callback => sub { $_[0] !~ /\d/ }) } sub bin_dir { shift->confirm } sub foo_dir { shift->unknown } ############################################################################## # 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. ok( $app = App::Info::Category::FooApp->new( on_error => $p), "Set up for error" ); $app->major; is( $stderr->read, "Error message\n", "Check error message" ); ############################################################################## # Clean up our mess. undef $stdout; undef $stdin; undef $stderr; untie *STDOUT; untie *STDIN; untie *STDERR; ############################################################################## # Test for errors when no key argument is passed. { my $msg; local $SIG{__DIE__} = sub { $msg = shift }; eval { $app->bin_dir }; like( $msg, qr/No key parameter passed to confirm/, "Check no key confirm" ); eval { $app->foo_dir }; like( $msg, qr/No key parameter passed to unknown/, "Check no key unknown" ); } ############################################################################## # Interactive tests for maintainer. if ($ENV{APP_INFO_MAINTAINER} && ! $ENV{HARNESS_ACTIVE}) { # Interactive tests for maintainer only. $app = App::Info::Category::FooApp->new( on_confirm => $p); $app->inc_dir; $app->lib_dir; } __END__ App-Info-0.57/t/request.t000444000765000024 304611577311664 14724 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 18; use File::Spec::Functions qw(tmpdir); BEGIN { use_ok('App::Info::Request') } ok( my $req = App::Info::Request->new, "New default request" ); isa_ok($req, 'App::Info::Request'); eval { App::Info::Request->new('foo') }; like( $@, qr/^Odd number of parameters in call to App::Info::Request->new\(\)/, "Catch invalid params" ); eval { App::Info::Request->new( callback => 'foo' ) }; like( $@, qr/^Callback parameter 'foo' is not a code reference/, "Catch invalid callback" ); # Now create a request we can actually use for testing stuff. my %args = ( message => 'Enter a value', callback => sub { ref $_[0] eq 'HASH' && $_[0]->{val} == 1 }, error => 'Invalid value', type => 'info', key => 'value', ); ok( $req = App::Info::Request->new( %args ), "New custom request" ); is( $req->key, $args{key}, "Check key" ); is( $req->message, $args{message}, "Check message" ); is( $req->error, $args{error}, "Check error" ); is( $req->type, $args{type}, "Check type" ); ok( !$req->callback('foo'), "Fail callback" ); my $val = { val => 1 }; ok( $req->callback($val), "Succeed callback" ); ok( ! $req->value({ val => 0 }), "Fail value" ); ok( $req->value($val), "Succeed value" ); is( $req->value, $val, "Check value" ); # Try changing the callback to use $_. $args{callback} = sub { -d }; ok( $req = App::Info::Request->new( %args ), "Another custom request" ); ok( $req->callback(tmpdir), 'Try $_ callback'); ok( !$req->callback('foo234234'), 'Fail $_ callback' ); App-Info-0.57/t/sqlite.t000555000765000024 267411577311664 14546 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 18; use File::Spec::Functions; BEGIN { use_ok('App::Info::RDBMS::SQLite') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; my $lib_dir = catdir 't', 'testlib'; my $inc_dir = catdir 't', 'testinc'; my $executable = catfile $bin_dir, "sqlite3$ext"; ok( my $sqlite = App::Info::RDBMS::SQLite->new( search_bin_dirs => [$bin_dir], search_exe_names => ["sqlite3$ext"], search_lib_dirs => [$lib_dir], search_inc_dirs => [$inc_dir], ), "Got Object"); isa_ok($sqlite, 'App::Info::RDBMS::SQLite'); isa_ok($sqlite, 'App::Info'); is( $sqlite->key_name, 'SQLite', "Check key name" ); ok( $sqlite->installed, "SQLite is installed" ); is( $sqlite->name, "SQLite", "Get name" ); is( $sqlite->version, "3.0.7", "Test Version" ); is( $sqlite->major_version, '3', "Test major version" ); is( $sqlite->minor_version, '0', "Test minor version" ); is( $sqlite->patch_version, '7', "Test patch version" ); is( $sqlite->lib_dir, $lib_dir, "Test lib dir" ); is( $sqlite->executable, $executable, "Test executable" ); is( $sqlite->bin_dir, $bin_dir, "Test bin dir" ); is( $sqlite->so_lib_dir, $lib_dir, "Test so lib dir" ); is( $sqlite->inc_dir, $inc_dir, "Test inc dir" ); is( $sqlite->home_url, 'http://www.sqlite.org/', "Get home URL" ); is( $sqlite->download_url, 'http://www.sqlite.org/download.html', "Get download URL" ); App-Info-0.57/t/sqlite_info.t000555000765000024 566411577311664 15563 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 17; use constant SKIP => 13; ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib', 'lib'; } } chdir 't'; use EventTest; ############################################################################## BEGIN { use_ok('App::Info::RDBMS::SQLite') } # Test info events. ok( my $info = EventTest->new, "Create info EventTest" ); ok( my $sqlite = App::Info::RDBMS::SQLite->new( on_info => $info ), "Got Object"); is( $info->message, "Looking for SQLite", "Check constructor info" ); SKIP: { # Skip tests? skip "SQLite not installed", SKIP unless $sqlite->installed; # Check version. ok( $sqlite = App::Info::RDBMS::SQLite->new( on_info => $info ), "Got Object 2"); $info->message while defined $info->message; # Throw away constructor messages. $sqlite->version; like($info->message, qr/^(Executing `".*sqlite3?(.exe)?" -version`|Grabbing version from DBD::SQLite)$/, "Check version info" ); $sqlite->version; ok( ! defined $info->message, "No info" ); $sqlite->major_version; ok( ! defined $info->message, "Still No info" ); # Check major version. ok( $sqlite = App::Info::RDBMS::SQLite->new( on_info => $info ), "Got Object 3"); $info->message while defined $info->message; # Throw away constructor messages. $sqlite->major_version; like($info->message, qr/^(Executing `".*sqlite3?(.exe)?" -version`|Grabbing version from DBD::SQLite)$/, "Check major info" ); # Check minor version. ok( $sqlite = App::Info::RDBMS::SQLite->new( on_info => $info ), "Got Object 4"); $info->message while defined $info->message; # Throw away constructor messages. $sqlite->minor_version; like($info->message, qr/^(Executing `".*sqlite3?(.exe)?" -version`|Grabbing version from DBD::SQLite)$/, "Check minor info" ); # Check patch version. ok( $sqlite = App::Info::RDBMS::SQLite->new( on_info => $info ), "Got Object 5"); $info->message while defined $info->message; # Throw away constructor messages. $sqlite->patch_version; like($info->message, qr/^(Executing `".*sqlite3?(.exe)?" -version`|Grabbing version from DBD::SQLite)$/, "Check patch info" ); # Check dir methods. skip "No directories when using DBD::SQLite", 3 unless $sqlite->executable; $sqlite->inc_dir; like( $info->message, qr/^Searching for include directory$/, "Check inc info" ); $sqlite->lib_dir; like( $info->message, qr/^Searching for library directory$/, "Check lib info" ); $sqlite->so_lib_dir; like( $info->message, qr/^Searching for shared object library directory$/, "Check so lib info" ); } __END__ App-Info-0.57/t/util.t000444000765000024 1073011577311664 14227 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 22; use File::Spec::Functions; use File::Path; BEGIN { use_ok('App::Info::Util') } ok( my $util = App::Info::Util->new, "Create Util object" ); my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; # Test inheritance. my $root = $util->rootdir; is( $root, File::Spec::Functions::rootdir, "Inherited rootdir()" ); ok( $util->first_dir("C:\\foo", "C:\\bar", $root), "Test first_dir" ); # test first_path(). This is actually platform-dependent -- corrections # welcome. if ($^O eq 'MSWin32' or $^O eq 'os2') { is( $util->first_path("C:\\foo3424823;C:\\bar4294334834;$root"), $root, "Test first_path"); } elsif ($^O eq 'MacOS') { is( $util->first_path(":fooeijifjei:bareiojfiejfie:$root"), $root, "Test first_path"); } elsif ($^O eq 'VMS' or $^O eq 'epoc') { ok( ! defined $util->first_path, "first_path() returns undef on this platform" ); } else { # Assume unix. is( $util->first_path("/foo28384844:/bar949492393:$root"), $root, "Test first_path"); } # Test first_file(). First, create a file to find. my $tmpdir = $util->tmpdir; my $tmp_file = $util->catfile($tmpdir, 'app-info.tst'); open F, ">$tmp_file" or die "Cannot open $tmp_file: $!\n"; print F "King of the who?\nWell, I didn't vote for ya."; close F; # Now find the file. is( $util->first_file("this32432.foo", "that234324.foo", "C:\\foo434324.tst", $tmp_file), $tmp_file, "Test first_file" ); # Now find the same file with first_cat_path(). is( $util->first_cat_path('app-info.tst', $util->path, $tmpdir), $tmp_file, "Test first_cat_path" ); # And test it again using an array. is( $util->first_cat_path(['foo334.foo', 'bar224.foo', 'app-info.tst', '__ickypoo__'], $util->path, $tmpdir, "C:\\mytemp"), $tmp_file, "Test first_cat_path with array" ); # Now find the directory housing the file. is( $util->first_cat_dir('app-info.tst', $util->path, $tmpdir), $tmpdir, "Test first_cat_path" ); # And test it again using an array. is( $util->first_cat_dir(['foo24342434.foo', 'bar4323423.foo', 'app-info.tst', '__ickypoo__'], $util->path, $tmpdir, "C:\\mytemp"), $tmpdir, "Test first_cat_path with array" ); # Find an executable. is( $util->first_exe('this.foo', 'that.exe', "$bin_dir/iconv$ext"), "$bin_dir/iconv$ext", 'Find executable' ); # Test first_cat_exe(). is( $util->first_cat_exe("iconv$ext", '.', $bin_dir), catfile($bin_dir, "iconv$ext"), 'Test first_cat_exe' ); # Test it again with an array. is( $util->first_cat_exe( ['foowerwe.foo', 'barwere.foo', "iconv$ext", '__ickypoo__rs34'], '.', $bin_dir ), catfile($bin_dir, "iconv$ext"), "Test first_cat_exe with array" ); # Look for stuff in the file. is( $util->search_file($tmp_file, qr/(of.*\?)/), 'of the who?', "Find 'of the who?'" ); # Look for a couple of things at once. is_deeply( [$util->search_file($tmp_file, qr/(of\sthe)\s+(who\?)/)], ['of the', 'who?'], "Find 'of the' and 'who?'" ); ok( ! defined $util->search_file($tmp_file, qr/(__ickypoo__)/), "Find nothing" ); # Look for a couple of things. is_deeply([$util->multi_search_file($tmp_file, qr/(of.*\?)/, qr/(di.*e)/)], ['of the who?', "didn't vote"], "Find a couple" ); # Look for a couple of things on the same line. is_deeply([$util->multi_search_file($tmp_file, qr/(of.*\?)/, qr/(Ki[mn]g)/)], ['of the who?', "King"], "Find a couple on one line" ); # Look for a couple of things, but have one be undef. is_deeply([$util->multi_search_file($tmp_file, qr/(of.*\?)/, qr/(__ickypoo__)/)], ['of the who?', undef], "Find one but not the other" ); # And finally, find a couple of things where one is an array. is_deeply([$util->multi_search_file($tmp_file, qr/(of\sthe)\s+(who\?)/, qr/(Ki[mn]g)/)], [['of the', 'who?'], 'King'], "Find one an array ref and a scalar" ); # Don't forget to delete our temporary file. rmtree $tmp_file; # Test files_in_dir. my @dirs = ( qw(. ..), (-d '.svn' ? '.svn' : ()), qw(mod_dir.so mod_include.so mod_perl.so not_mod.txt) ); is_deeply [sort $util->files_in_dir(catdir(qw(t testmod))) ], \@dirs, 'files_for_dir should return all files in a directory'; @dirs = grep { /^mod_/ } @dirs; is_deeply [ sort $util->files_in_dir( catdir(qw(t testmod)), sub { /^mod_/ } ) ], \@dirs, 'files_for_dir should use the filter I pass'; App-Info-0.57/t/uuid.t000444000765000024 355411577311664 14206 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 23; use File::Spec::Functions; FAKEMOD: { # Fake presence of OSSP::uuid so that we can tell whether it's loaded. package OSSP::uuid; use File::Spec::Functions; $INC{ catfile qw(OSSP uuid.pm) } = __FILE__; } BEGIN { use_ok('App::Info::Lib::OSSPUUID') } my $ext = $^O eq 'MSWin32' ? '.bat' : ''; my $bin_dir = catdir 't', 'scripts'; $bin_dir = catdir 't', 'bin' unless -d $bin_dir; my $exe = catfile $bin_dir, "myuuid$ext"; ok my $uuid = App::Info::Lib::OSSPUUID->new( search_bin_dirs => $bin_dir, search_exe_names => "uuid-config$ext", search_uuid_names => "myuuid$ext", ), 'Got Object'; isa_ok $uuid, 'App::Info::Lib::OSSPUUID'; isa_ok $uuid, 'App::Info::Lib'; isa_ok $uuid, 'App::Info'; is $uuid->key_name, 'OSSP UUID', 'Check key name'; ok $uuid->installed, 'OSSP UUID is installed'; is $uuid->name, 'OSSP uuid', 'Get name'; is $uuid->version, '1.3.0', 'Test Version'; is $uuid->major_version, '1', 'Test major version'; is $uuid->minor_version, '3', 'Test minor version'; is $uuid->patch_version, '0', 'Test patch version'; is $uuid->lib_dir, 't/testlib', 'Test lib dir'; is $uuid->executable, $exe, 'Test executable'; is $uuid->uuid, $exe, 'Test uuid'; is $uuid->bin_dir, $bin_dir, 'Test bin dir'; is $uuid->so_lib_dir, 't/testlib', 'Test so lib dir'; is $uuid->inc_dir, 't/testinc', 'Test inc dir'; is $uuid->cflags, '-I/usr/local/include', 'Test configure'; is $uuid->ldflags, '-L/usr/local/lib', 'Test configure'; ok $uuid->perl_module, 'OSSP::uuid should appear to be installed'; is $uuid->home_url, 'http://www.ossp.org/pkg/lib/uuid/', 'Get home URL'; is $uuid->download_url, 'http://www.ossp.org/pkg/lib/uuid/', 'Get download URL'; App-Info-0.57/t/uuid_info.t000444000765000024 610311577311664 15212 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 22; use constant SKIP => 18; ############################################################################## # Make sure that we can use the stuff that's in our local lib directory. BEGIN { unshift @INC, 't/lib', 'lib'; } chdir 't'; use EventTest; ############################################################################## BEGIN { use_ok('App::Info::Lib::OSSPUUID') } my $ext = $^O eq 'MSWin32' ? '[.]exe' : ''; # Test info events. ok( my $info = EventTest->new, "Create info EventTest" ); ok( my $uuid = App::Info::Lib::OSSPUUID->new( on_info => $info ), "Got Object"); is( $info->message, "Looking for uuid-config", "Check constructor info" ); SKIP: { # Skip tests? skip 'OSSP UUID Library not installed', SKIP unless $uuid->installed; # Check name. $uuid->name; like($info->message, qr/^Executing `".*uuid-config$ext" --version`$/, "Check name info" ); $uuid->name; ok( ! defined $info->message, "No info" ); $uuid->version; ok( ! defined $info->message, "Still No info" ); # Check version. ok( $uuid = App::Info::Lib::OSSPUUID->new( on_info => $info ), "Got Object 2"); $info->message; # Throw away constructor message. $uuid->version; like($info->message, qr/^Executing `".*uuid-config$ext" --version`$/, "Check version info" ); $uuid->version; ok( ! defined $info->message, "No info" ); $uuid->major_version; ok( ! defined $info->message, "Still No info" ); # Check major version. ok( $uuid = App::Info::Lib::OSSPUUID->new( on_info => $info ), "Got Object 3"); $info->message; # Throw away constructor message. $uuid->major_version; like($info->message, qr/^Executing `".*uuid-config$ext" --version`$/, "Check major info" ); # Check minor version. ok( $uuid = App::Info::Lib::OSSPUUID->new( on_info => $info ), "Got Object 4"); $info->message; # Throw away constructor message. $uuid->minor_version; like($info->message, qr/^Executing `".*uuid-config$ext" --version`$/, "Check minor info" ); # Check patch version. ok( $uuid = App::Info::Lib::OSSPUUID->new( on_info => $info ), "Got Object 5"); $info->message; # Throw away constructor message. $uuid->patch_version; like($info->message, qr/^Executing `".*uuid-config$ext" --version`$/, "Check patch info" ); # Check dir methods. $uuid->bin_dir; like( $info->message, qr/^Executing `".*uuid-config$ext" --bindir`$/, "Check bin info" ); $uuid->inc_dir; like( $info->message, qr/^Executing `".*uuid-config$ext" --includedir`$/, "Check inc info" ); $uuid->lib_dir; like( $info->message, qr/^Executing `".*uuid-config$ext" --libdir`$/, "Check lib info" ); $uuid->cflags; # Check configure info. like( $info->message, qr/^Executing `".*uuid-config$ext" --cflags`$/, "Check cflags info" ); $uuid->ldflags; like( $info->message, qr/^Executing `".*uuid-config$ext" --ldflags`$/, "Check ldflags info" ); } __END__ App-Info-0.57/t/zpod.t000444000765000024 26511577311664 14170 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(all_pod_files('lib')); App-Info-0.57/t/bin000755000765000024 011577311664 13457 5ustar00davidstaff000000000000App-Info-0.57/t/bin/httpd000555000765000024 260311577311664 14666 0ustar00davidstaff000000000000#!/usr/bin/perl -w if ($ARGV[0] eq '-v') { print "Server version: Apache/1.3.31 (Darwin)\nServer built: Oct 23 2004 12:16:31\n"; } elsif ($ARGV[0] eq '-V') { print <<'EOF'; Server version: Apache/1.3.31 (Darwin) Server built: Oct 23 2004 12:16:31 Server's Module Magic Number: 19990320:16 Server compiled with.... -D EAPI -D EAPI_MM -D EAPI_MM_CORE_PATH="logs/httpd.mm" -D HAVE_MMAP -D USE_MMAP_SCOREBOARD -D USE_MMAP_FILES -D HAVE_FCNTL_SERIALIZED_ACCEPT -D HAVE_FLOCK_SERIALIZED_ACCEPT -D SINGLE_LISTEN_UNSERIALIZED_ACCEPT -D DYNAMIC_MODULE_LIMIT=64 -D HARD_SERVER_LIMIT=256 -D HTTPD_ROOT="t" -D SUEXEC_BIN="t/bin" -D DEFAULT_PIDLOG="logs/httpd.pid" -D DEFAULT_SCOREBOARD="logs/httpd.scoreboard" -D DEFAULT_LOCKFILE="logs/httpd.lock" -D DEFAULT_ERRORLOG="logs/error_log" -D TYPES_CONFIG_FILE="conf/mime.types" -D SERVER_CONFIG_FILE="t/testlib/httpd.conf" -D ACCESS_CONFIG_FILE="conf/access.conf" -D RESOURCE_CONFIG_FILE="conf/srm.conf" EOF } elsif ($ARGV[0] eq '-l') { print <<'EOF'; Compiled-in modules: http_core.c mod_env.c mod_log_config.c mod_mime.c mod_negotiation.c mod_status.c mod_include.c mod_autoindex.c mod_dir.c mod_cgi.c mod_asis.c mod_imap.c mod_actions.c mod_userdir.c mod_alias.c mod_rewrite.c mod_access.c mod_auth.c mod_so.c mod_setenvif.c mod_ssl.c mod_perl.c suexec: disabled; invalid wrapper t/bin EOF } App-Info-0.57/t/bin/httpd2000555000765000024 235511577311664 14754 0ustar00davidstaff000000000000#!/usr/bin/perl -w if ($ARGV[0] eq '-v') { print "Server version: Apache/2.0.55\nServer built: Dec 28 2005 11:23:02\n"; } elsif ($ARGV[0] eq '-V') { print <<'EOF'; Server version: Apache/2.0.55 Server built: Dec 28 2005 11:23:02 Server's Module Magic Number: 20020903:11 Architecture: 32-bit Server compiled with.... -D APACHE_MPM_DIR="server/mpm/prefork" -D APR_HAS_MMAP -D APR_HAVE_IPV6 (IPv4-mapped addresses enabled) -D APR_USE_SYSVSEM_SERIALIZE -D APR_USE_PTHREAD_SERIALIZE -D SINGLE_LISTEN_UNSERIALIZED_ACCEPT -D APR_HAS_OTHER_CHILD -D AP_HAVE_RELIABLE_PIPED_LOGS -D HTTPD_ROOT="t" -D SUEXEC_BIN="/usr/local/apache2/bin/suexec" -D DEFAULT_PIDLOG="logs/httpd.pid" -D DEFAULT_SCOREBOARD="logs/apache_runtime_status" -D DEFAULT_LOCKFILE="logs/accept.lock" -D DEFAULT_ERRORLOG="logs/error_log" -D AP_TYPES_CONFIG_FILE="conf/mime.types" -D SERVER_CONFIG_FILE="conf/httpd.conf" EOF } elsif ($ARGV[0] eq '-l') { print <<'EOF'; Compiled in modules: core.c mod_access.c mod_auth.c mod_log_config.c mod_setenvif.c prefork.c http_core.c mod_mime.c mod_status.c mod_autoindex.c mod_asis.c mod_cgi.c mod_negotiation.c mod_dir.c mod_imap.c mod_actions.c mod_userdir.c mod_alias.c mod_so.c EOF } App-Info-0.57/t/bin/iconv000555000765000024 3111577311664 14612 0ustar00davidstaff000000000000#!/usr/bin/perl -w exit;App-Info-0.57/t/bin/myapxs000555000765000024 14611577311664 15044 0ustar00davidstaff000000000000#!/usr/bin/perl -w use File::Spec::Functions; print catdir qw(t testmod) if $ARGV[0] eq '-q'; exit; App-Info-0.57/t/bin/mycreatedb000555000765000024 3211577311664 15614 0ustar00davidstaff000000000000#!/usr/bin/perl -w exit; App-Info-0.57/t/bin/myuuid000555000765000024 3211577311664 15011 0ustar00davidstaff000000000000#!/usr/bin/perl -w exit; App-Info-0.57/t/bin/pg_config000555000765000024 72011577311664 15454 0ustar00davidstaff000000000000#!/usr/bin/perl -w use File::Spec::Functions; my $bin_dir = catdir qw(t scripts); $bin_dir = catdir(qw(t bin)) unless -d $bin_dir; if ($ARGV[0] eq '--version') { print "PostgreSQL 8.0.0\n"; } elsif ($ARGV[0] eq '--bindir') { print "$bin_dir\n"; } elsif ($ARGV[0] eq '--includedir') { print "t/testinc\n"; } elsif ($ARGV[0] eq '--libdir' || $ARGV[0] eq '--pkglibdir') { print "t/testlib\n"; } elsif ($ARGV[0] eq '--configure') { print "\n"; } App-Info-0.57/t/bin/postgres000555000765000024 3211577311664 15343 0ustar00davidstaff000000000000#!/usr/bin/perl -w exit; App-Info-0.57/t/bin/sqlite3000555000765000024 7711577311664 15072 0ustar00davidstaff000000000000#!/usr/bin/perl -w print "3.0.7\n" if $ARGV[0] eq '-version'; App-Info-0.57/t/bin/uuid-config000555000765000024 103011577311664 15745 0ustar00davidstaff000000000000#!/usr/bin/perl -w use File::Spec::Functions; my $bin_dir = catdir qw(t scripts); $bin_dir = catdir(qw(t bin)) unless -d $bin_dir; if ($ARGV[0] eq '--version') { print "OSSP uuid 1.3.0 (02-Sep-2005)\n"; } elsif ($ARGV[0] eq '--bindir') { print "$bin_dir\n"; } elsif ($ARGV[0] eq '--includedir') { print "t/testinc\n"; } elsif ($ARGV[0] eq '--libdir') { print "t/testlib\n"; } elsif ($ARGV[0] eq '--cflags') { print "-I/usr/local/include\n"; } elsif ($ARGV[0] eq '--ldflags') { print "-L/usr/local/lib\n"; } App-Info-0.57/t/lib000755000765000024 011577311664 13455 5ustar00davidstaff000000000000App-Info-0.57/t/lib/EventTest.pm000444000765000024 104011577311664 16064 0ustar00davidstaff000000000000package EventTest; use strict; use App::Info::Handler; use vars qw(@ISA); @ISA = 'App::Info::Handler'; sub new { my $pkg = shift; my $self = $pkg->SUPER::new(@_); $self->{req} = []; return $self; } sub request { return shift @{$_[0]->{req}}; } sub requests { my @reqs = @{$_[0]->{req}}; @{$_[0]->{req}} = (); return wantarray ? @reqs : \@reqs; } sub message { my $req = shift->request or return; return $req->message; } sub handler { my $self = shift; push @{$self->{req}}, shift; 1; } App-Info-0.57/t/lib/TieOut.pm000444000765000024 65711577311664 15351 0ustar00davidstaff000000000000package TieOut; # This module is swiped and adapted from ExtUtils::MakeMaker. sub TIEHANDLE { bless [], ref $_[0] || $_[0] } sub PRINT { my $self = shift; push @$self, join '', @_; } sub PRINTF { my $self = shift; push @$self, sprintf @_; } sub READLINE { my $self = shift; return shift @$self; } sub read { my $self = shift; my $ret = join '', @$self; @$self = (); return $ret; } 1; App-Info-0.57/t/scripts000755000765000024 011577311664 14376 5ustar00davidstaff000000000000App-Info-0.57/t/scripts/httpd000555000765000024 310311577311664 15601 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell if ($ARGV[0] eq '-v') { print "Server version: Apache/1.3.31 (Darwin)\nServer built: Oct 23 2004 12:16:31\n"; } elsif ($ARGV[0] eq '-V') { print <<'EOF'; Server version: Apache/1.3.31 (Darwin) Server built: Oct 23 2004 12:16:31 Server's Module Magic Number: 19990320:16 Server compiled with.... -D EAPI -D EAPI_MM -D EAPI_MM_CORE_PATH="logs/httpd.mm" -D HAVE_MMAP -D USE_MMAP_SCOREBOARD -D USE_MMAP_FILES -D HAVE_FCNTL_SERIALIZED_ACCEPT -D HAVE_FLOCK_SERIALIZED_ACCEPT -D SINGLE_LISTEN_UNSERIALIZED_ACCEPT -D DYNAMIC_MODULE_LIMIT=64 -D HARD_SERVER_LIMIT=256 -D HTTPD_ROOT="t" -D SUEXEC_BIN="t/bin" -D DEFAULT_PIDLOG="logs/httpd.pid" -D DEFAULT_SCOREBOARD="logs/httpd.scoreboard" -D DEFAULT_LOCKFILE="logs/httpd.lock" -D DEFAULT_ERRORLOG="logs/error_log" -D TYPES_CONFIG_FILE="conf/mime.types" -D SERVER_CONFIG_FILE="t/testlib/httpd.conf" -D ACCESS_CONFIG_FILE="conf/access.conf" -D RESOURCE_CONFIG_FILE="conf/srm.conf" EOF } elsif ($ARGV[0] eq '-l') { print <<'EOF'; Compiled-in modules: http_core.c mod_env.c mod_log_config.c mod_mime.c mod_negotiation.c mod_status.c mod_include.c mod_autoindex.c mod_dir.c mod_cgi.c mod_asis.c mod_imap.c mod_actions.c mod_userdir.c mod_alias.c mod_rewrite.c mod_access.c mod_auth.c mod_so.c mod_setenvif.c mod_ssl.c mod_perl.c suexec: disabled; invalid wrapper t/bin EOF } App-Info-0.57/t/scripts/httpd2000555000765000024 265511577311664 15676 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell if ($ARGV[0] eq '-v') { print "Server version: Apache/2.0.55\nServer built: Dec 28 2005 11:23:02\n"; } elsif ($ARGV[0] eq '-V') { print <<'EOF'; Server version: Apache/2.0.55 Server built: Dec 28 2005 11:23:02 Server's Module Magic Number: 20020903:11 Architecture: 32-bit Server compiled with.... -D APACHE_MPM_DIR="server/mpm/prefork" -D APR_HAS_MMAP -D APR_HAVE_IPV6 (IPv4-mapped addresses enabled) -D APR_USE_SYSVSEM_SERIALIZE -D APR_USE_PTHREAD_SERIALIZE -D SINGLE_LISTEN_UNSERIALIZED_ACCEPT -D APR_HAS_OTHER_CHILD -D AP_HAVE_RELIABLE_PIPED_LOGS -D HTTPD_ROOT="t" -D SUEXEC_BIN="/usr/local/apache2/bin/suexec" -D DEFAULT_PIDLOG="logs/httpd.pid" -D DEFAULT_SCOREBOARD="logs/apache_runtime_status" -D DEFAULT_LOCKFILE="logs/accept.lock" -D DEFAULT_ERRORLOG="logs/error_log" -D AP_TYPES_CONFIG_FILE="conf/mime.types" -D SERVER_CONFIG_FILE="conf/httpd.conf" EOF } elsif ($ARGV[0] eq '-l') { print <<'EOF'; Compiled in modules: core.c mod_access.c mod_auth.c mod_log_config.c mod_setenvif.c prefork.c http_core.c mod_mime.c mod_status.c mod_autoindex.c mod_asis.c mod_cgi.c mod_negotiation.c mod_dir.c mod_imap.c mod_actions.c mod_userdir.c mod_alias.c mod_so.c EOF } App-Info-0.57/t/scripts/iconv000555000765000024 33111577311664 15554 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell exit;App-Info-0.57/t/scripts/myapxs000555000765000024 44611577311664 15766 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell use File::Spec::Functions; print catdir qw(t testmod) if $ARGV[0] eq '-q'; exit; App-Info-0.57/t/scripts/mycreatedb000555000765000024 33211577311664 16556 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell exit; App-Info-0.57/t/scripts/myuuid000555000765000024 33211577311664 15753 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell exit; App-Info-0.57/t/scripts/pg_config000555000765000024 122011577311664 16407 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell use File::Spec::Functions; my $bin_dir = catdir qw(t scripts); $bin_dir = catdir(qw(t bin)) unless -d $bin_dir; if ($ARGV[0] eq '--version') { print "PostgreSQL 8.0.0\n"; } elsif ($ARGV[0] eq '--bindir') { print "$bin_dir\n"; } elsif ($ARGV[0] eq '--includedir') { print "t/testinc\n"; } elsif ($ARGV[0] eq '--libdir' || $ARGV[0] eq '--pkglibdir') { print "t/testlib\n"; } elsif ($ARGV[0] eq '--configure') { print "\n"; } App-Info-0.57/t/scripts/postgres000555000765000024 33211577311664 16305 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell exit; App-Info-0.57/t/scripts/sqlite3000555000765000024 37711577311664 16034 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell print "3.0.7\n" if $ARGV[0] eq '-version'; App-Info-0.57/t/scripts/uuid-config000555000765000024 133011577311664 16667 0ustar00davidstaff000000000000#!/usr/local/bin/perl -w eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell use File::Spec::Functions; my $bin_dir = catdir qw(t scripts); $bin_dir = catdir(qw(t bin)) unless -d $bin_dir; if ($ARGV[0] eq '--version') { print "OSSP uuid 1.3.0 (02-Sep-2005)\n"; } elsif ($ARGV[0] eq '--bindir') { print "$bin_dir\n"; } elsif ($ARGV[0] eq '--includedir') { print "t/testinc\n"; } elsif ($ARGV[0] eq '--libdir') { print "t/testlib\n"; } elsif ($ARGV[0] eq '--cflags') { print "-I/usr/local/include\n"; } elsif ($ARGV[0] eq '--ldflags') { print "-L/usr/local/lib\n"; } App-Info-0.57/t/testinc000755000765000024 011577311664 14360 5ustar00davidstaff000000000000App-Info-0.57/t/testinc/expat.h000444000765000024 12511577311664 15765 0ustar00davidstaff000000000000#define XML_MAJOR_VERSION 1 #define XML_MINOR_VERSION 95 #define XML_MICRO_VERSION 8 App-Info-0.57/t/testinc/iconv.h000444000765000024 11511577311664 15761 0ustar00davidstaff000000000000#define _LIBICONV_VERSION 0x0109 /* version number: (major<<8) + minor */ App-Info-0.57/t/testinc/sqlite3.h000444000765000024 011577311664 16160 0ustar00davidstaff000000000000App-Info-0.57/t/testlib000755000765000024 011577311664 14355 5ustar00davidstaff000000000000App-Info-0.57/t/testlib/httpd.conf000444000765000024 16311577311664 16464 0ustar00davidstaff000000000000Port 80 User nobody Group nobody DocumentRoot "/test/doc/root" ScriptAlias /test/cgi-bin/ /this/is/a/test/cgi-bin/ App-Info-0.57/t/testlib/libexpat.so000444000765000024 011577311664 16573 0ustar00davidstaff000000000000App-Info-0.57/t/testlib/libiconv.so000444000765000024 011577311664 16570 0ustar00davidstaff000000000000App-Info-0.57/t/testlib/libsqlite3.so000444000765000024 011577311664 17036 0ustar00davidstaff000000000000App-Info-0.57/t/testmod000755000765000024 011577311664 14366 5ustar00davidstaff000000000000App-Info-0.57/t/testmod/mod_dir.so000444000765000024 011577311664 16411 0ustar00davidstaff000000000000App-Info-0.57/t/testmod/mod_include.so000444000765000024 011577311664 17256 0ustar00davidstaff000000000000App-Info-0.57/t/testmod/mod_perl.so000444000765000024 011577311664 16575 0ustar00davidstaff000000000000App-Info-0.57/t/testmod/not_mod.txt000444000765000024 011577311664 16631 0ustar00davidstaff000000000000