App-Cmd-0.323000755000766000024 012250623320 12162 5ustar00rjbsstaff000000000000README100644000766000024 46212250623320 13105 0ustar00rjbsstaff000000000000App-Cmd-0.323 This archive contains the distribution App-Cmd, version 0.323: write command line apps with less suffering This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Changes100644000766000024 1555712250623320 13573 0ustar00rjbsstaff000000000000App-Cmd-0.323Revision history for App-Cmd 0.323 2013-12-07 08:46:51 America/New_York fall back to "(unknown)" for command abstract in more cases (thanks, Jakob Voss!) 0.322 2013-10-28 08:00:35 America/New_York require a newer Getopt::Long to avoid --version conflicts 0.321 2013-10-26 07:44:19 America/New_York avoiding getting [undef] in argument list in Simple apps add --version support via version command (thanks, Jakob Voss!) 0.320 2013-01-30 19:37:46 America/New_York when answering "Unknown subcommand," the commands list is sent ot STDERR (#75652) tests for using Params::Validate callback and not getting nasty stack trace (thanks, Adam Prime) 0.319 2013-01-25 18:18:21 America/New_York Enable --help option for App::Cmd::Simple (thanks, Ryan Thompson!) add the ability to ignore non-commands (Thanks, Kent Fredric!) many improvements to tutorial (thanks, mokko!) 0.318 2012-05-04 22:00:34 America/New_York App::Cmd::Tester treats undef code as 0 now (thanks, David Golden) piles of documentation improvement also by David Golden 0.317 2012-03-26 10:11:52 America/New_York App::Cmd::Tester now reports exit code 1 for unknown commands, as App::Cmd would exit(1) in that case; addresses https://rt.cpan.org/Public/Bug/Display.html?id=73084 reported by David Golden 0.316 2012-02-11 10:50:46 America/New_York fix the test of "echo" on Win32 (thanks, Chris Williams) 0.315 2012-02-10 09:08:49 America/New_York totally worthless release made by mistake 0.314 2012-01-03 21:38:59 America/New_York adds App::Cmd::Tester::CaptureExternal to capture output from external subcommands (thanks, David Golden) if there's no Pod =head1 NAME, a Pod::Weaver-esque #ABSTRACT will be respected (thanks, Andreas Hernitscheck) 0.313 2011-12-23 13:29:53 America/New_York don't load Text::Abbrev until it's needed (thanks, Olivier Mengué) 0.312 2011-08-17 18:02:26 America/New_York typo fixes to docs (thanks, Glenn Fowler) add the prepare_argv method (thanks, Ingy döt Net) 0.311 2011-03-17 22:42:19 America/New_York require the correct version of Getopt::Long::Descriptive (thanks, Glen Hinkle) 0.310 2010-12-11 classes are now loaded with Class::Load, which should avoid bugs where classes are not succesfully loaded by program execution continues anyway (thanks to Kent Fredric) more checking is now done to ensure that plugins are members of the correct base class (thanks, Kent Fredric) 0.309 2010-11-12 skip a failing test on perl 5.8.x 0.308 2010-11-08 When App::Cmd::Setup tries to load MyApp::Command, and it exists but will not compile, the exception will now propagate. Previously, it failed silently and App::Cmd::Command was used instead. (bug found and fixed and tested for by Kent Fredric; thanks!) 0.307 2010-03-09 bump up required version of Getopt::Long::Descriptive 0.306 2010-03-08 return the App::Cmd object (when non-Simple) in the Tester result allow App::Cmd::Tester subclasses to chose another Result class 0.305 2010-03-07 App::Cmd::Tester now reports (probable?) exit code of tested apps some improvements to the tutorial and other docs added some documentation for App::Cmd::Setup now searches for plugins under App::Cmd::Plugin::; use = to prevent 0.304 2009-12-07 remove use of deprecated "-run" from synopsis (thanks, George Hartzell) 0.303 2009-11-27 revert behavior of App::Cmd 0.302 -- GLD no longer gives undef opts 0.302 2009-11-27 expect undef values for acceptable-but-ungiven options in $opt 0.301 2009-09-02 fix App::Cmd::Simple docs to show ->execute (noticed by MIYAGAWA) 0.300 2009-08-28 DEPRECATED -run OPTION TO APP CLASS IMPORT "use MyApp -run;" is deprecated; it will be removed after no less than a year this led to problems where normal exit-on-error messages confused users by complaining about failing to compile; magic to stop this is not worth the tiny savings COMMANDS SHOULD NOW HAVE ->execute RATHER THAN ->run this will not break you code... except: WILL BREAK YOUR CODE: App::Cmd::Simple programs must use ->execute rather than ->run 0.207 2009-08-27 add option to allow any unambiguous command abbreviation (thanks, Jerome Quelin) 0.206 2009-08-19 add a ->description to commands (thanks, Jerome Quelin) 0.205 2009-08-18 add the long-missing arg0 and full_arg0 accessors (resolves 35528) thanks to GAISSMAI and Jerome Quelin for reporting 0.204 2009-06-27 document the need for calling ->import on Simple apps add tests for Simple-based apps correct a few errors in the tutorial (thanks, Jason Crome) 0.203 2009-01-16 add repo info to metadata 0.202 2008-10-16 update App::Cmd::Tester to use IO::TieCombine 0.201 2008-10-14 fix typos in Tutorial.pod (thanks, HARTZELL!) fix prereq for Sub::Exporter to ensure we have curry_method 0.200 2008-09-14 new super-concise ::Setup interface provided by Sub::Exporter added plugin system consult App::Cmd::Tutorial to see the new interface your old code should still work! 0.013 2008-03-19 add arg0 and full_arg0 methods 0.012 2007-11-19 refresh Module::Install 0.011 2007-10-12 BUG FIX: note new prereqs 0.010 2007-10-05 MAJORLY NEW: App::Cmd::Simple for one-command apps 0.009 2007-10-05 BUG FIX: default_command/_plugin method names were not consistent TRIVIA: come into line with some code writing policies 0.008 2006-11-16 documentation fixes perl-critic tests 0.007 2006-08-25 documentation improvements refactoring and reordering of code 0.006 2006-08-25 gracefully ignore invalid plugins (NUFFIN) some tweaks to "help" (NUFFIN) actually make "help" the default some documenation improvements 0.005 2006-08-23 this release brought to you by NUFFIN! allow subcommands (commands beneath commands) add a default "help" command support global options improve documentation and tutorial extensive minor refactorings and improvements 0.002 2006-06-14 fix test plan 0.001 2006-06-12 first release (not counting Rubric::CLI) LICENSE100644000766000024 4366112250623320 13302 0ustar00rjbsstaff000000000000App-Cmd-0.323This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Ricardo Signes. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Ricardo Signes. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644000766000024 34212250623320 13666 0ustar00rjbsstaff000000000000App-Cmd-0.323name = App-Cmd author = Ricardo Signes license = Perl_5 copyright_holder = Ricardo Signes [@RJBS] github_issues = 1 [Prereqs] Getopt::Long = 2.39 ; avoid --version mixup Getopt::Long::Descriptive = 0.084 META.yml100644000766000024 2062312250623320 13537 0ustar00rjbsstaff000000000000App-Cmd-0.323--- abstract: 'write command line apps with less suffering' author: - 'Ricardo Signes ' build_requires: Data::Dumper: 0 IPC::Cmd: 0 Test::Fatal: 0 Test::More: 0.96 base: 0 lib: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: App-Cmd requires: Capture::Tiny: 0.13 Carp: 0 Class::Load: 0.06 Data::OptList: 0 File::Basename: 0 Getopt::Long: 2.39 Getopt::Long::Descriptive: 0.084 IO::TieCombine: 0 Module::Pluggable::Object: 0 String::RewritePrefix: 0 Sub::Exporter: 0 Sub::Exporter::Util: 0 Sub::Install: 0 Text::Abbrev: 0 constant: 0 parent: 0 perl: 5.006 strict: 0 warnings: 0 resources: bugtracker: https://github.com/rjbs/App-Cmd/issues homepage: https://github.com/rjbs/App-Cmd repository: https://github.com/rjbs/App-Cmd.git version: 0.323 x_Dist_Zilla: perl: version: 5.018001 plugins: - class: Dist::Zilla::Plugin::Git::GatherDir name: '@RJBS/Git::GatherDir' version: 2.019 - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: '@RJBS/CheckPrereqsIndexed' version: 0.009 - class: Dist::Zilla::Plugin::CheckExtraTests name: '@RJBS/CheckExtraTests' version: 0.016 - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 0 check_all_prereqs: 0 modules: - Dist::Zilla::PluginBundle::RJBS phase: build skip: [] name: '@RJBS/RJBS-Outdated' version: 0.014 - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 1 check_all_prereqs: 0 modules: [] phase: release skip: [] name: '@RJBS/CPAN-Outdated' version: 0.014 - class: Dist::Zilla::Plugin::PruneCruft name: '@RJBS/@Filter/PruneCruft' version: 5.006 - class: Dist::Zilla::Plugin::ManifestSkip name: '@RJBS/@Filter/ManifestSkip' version: 5.006 - class: Dist::Zilla::Plugin::MetaYAML name: '@RJBS/@Filter/MetaYAML' version: 5.006 - class: Dist::Zilla::Plugin::License name: '@RJBS/@Filter/License' version: 5.006 - class: Dist::Zilla::Plugin::Readme name: '@RJBS/@Filter/Readme' version: 5.006 - class: Dist::Zilla::Plugin::ExecDir name: '@RJBS/@Filter/ExecDir' version: 5.006 - class: Dist::Zilla::Plugin::ShareDir name: '@RJBS/@Filter/ShareDir' version: 5.006 - class: Dist::Zilla::Plugin::MakeMaker name: '@RJBS/@Filter/MakeMaker' version: 5.006 - class: Dist::Zilla::Plugin::Manifest name: '@RJBS/@Filter/Manifest' version: 5.006 - class: Dist::Zilla::Plugin::TestRelease name: '@RJBS/@Filter/TestRelease' version: 5.006 - class: Dist::Zilla::Plugin::ConfirmRelease name: '@RJBS/@Filter/ConfirmRelease' version: 5.006 - class: Dist::Zilla::Plugin::UploadToCPAN name: '@RJBS/@Filter/UploadToCPAN' version: 5.006 - class: Dist::Zilla::Plugin::AutoPrereqs name: '@RJBS/AutoPrereqs' version: 5.006 - class: Dist::Zilla::Plugin::Git::NextVersion name: '@RJBS/Git::NextVersion' version: 2.019 - class: Dist::Zilla::Plugin::PkgVersion name: '@RJBS/PkgVersion' version: 5.006 - class: Dist::Zilla::Plugin::MetaConfig name: '@RJBS/MetaConfig' version: 5.006 - class: Dist::Zilla::Plugin::MetaJSON name: '@RJBS/MetaJSON' version: 5.006 - class: Dist::Zilla::Plugin::NextRelease name: '@RJBS/NextRelease' version: 5.006 - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: '@RJBS/Test::ChangesHasContent' version: 0.006 - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@RJBS/PodSyntaxTests' version: 5.006 - class: Dist::Zilla::Plugin::ReportVersions::Tiny name: '@RJBS/ReportVersions::Tiny' version: 1.10 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@RJBS/TestMoreWithSubtests' version: 5.006 - class: Dist::Zilla::Plugin::PodWeaver config: Dist::Zilla::Plugin::PodWeaver: config_plugin: '@RJBS' finder: - ':InstallModules' - ':ExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: 4.004 - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: 4.004 - class: Pod::Weaver::Plugin::SingleEncoding name: '@RJBS/SingleEncoding' version: 4.004 - class: Pod::Weaver::Section::Name name: '@RJBS/Name' version: 4.004 - class: Pod::Weaver::Section::Version name: '@RJBS/Version' version: 4.004 - class: Pod::Weaver::Section::Region name: '@RJBS/Prelude' version: 4.004 - class: Pod::Weaver::Section::Generic name: '@RJBS/Synopsis' version: 4.004 - class: Pod::Weaver::Section::Generic name: '@RJBS/Description' version: 4.004 - class: Pod::Weaver::Section::Generic name: '@RJBS/Overview' version: 4.004 - class: Pod::Weaver::Section::Generic name: '@RJBS/Stability' version: 4.004 - class: Pod::Weaver::Section::Collect name: Attributes version: 4.004 - class: Pod::Weaver::Section::Collect name: Methods version: 4.004 - class: Pod::Weaver::Section::Collect name: Functions version: 4.004 - class: Pod::Weaver::Section::Leftovers name: '@RJBS/Leftovers' version: 4.004 - class: Pod::Weaver::Section::Region name: '@RJBS/postlude' version: 4.004 - class: Pod::Weaver::Section::Authors name: '@RJBS/Authors' version: 4.004 - class: Pod::Weaver::Section::Legal name: '@RJBS/Legal' version: 4.004 - class: Pod::Weaver::Plugin::Transformer name: '@RJBS/List' version: 4.004 name: '@RJBS/PodWeaver' version: 4.002 - class: Dist::Zilla::Plugin::GithubMeta name: '@RJBS/GithubMeta' version: 0.42 - class: Dist::Zilla::Plugin::Git::Check name: '@RJBS/@Git/Check' version: 2.019 - class: Dist::Zilla::Plugin::Git::Commit name: '@RJBS/@Git/Commit' version: 2.019 - class: Dist::Zilla::Plugin::Git::Tag name: '@RJBS/@Git/Tag' version: 2.019 - class: Dist::Zilla::Plugin::Git::Push name: '@RJBS/@Git/Push' version: 2.019 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: 5.006 zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: 5.006 MANIFEST100644000766000024 314212250623320 13374 0ustar00rjbsstaff000000000000App-Cmd-0.323Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/App/Cmd.pm lib/App/Cmd/ArgProcessor.pm lib/App/Cmd/Command.pm lib/App/Cmd/Command/commands.pm lib/App/Cmd/Command/help.pm lib/App/Cmd/Command/version.pm lib/App/Cmd/Plugin.pm lib/App/Cmd/Setup.pm lib/App/Cmd/Simple.pm lib/App/Cmd/Subdispatch.pm lib/App/Cmd/Subdispatch/DashedStyle.pm lib/App/Cmd/Tester.pm lib/App/Cmd/Tester/CaptureExternal.pm lib/App/Cmd/Tutorial.pod t/00-load.t t/000-report-versions-tiny.t t/abbrev.t t/basic.t t/callback.t t/capture-ext.t t/lib/Test/BrokenCmd.pm t/lib/Test/BrokenCmd/Command.pm t/lib/Test/IgnoreCommand.pm t/lib/Test/IgnoreCommand/Command.pm t/lib/Test/MyCmd.pm t/lib/Test/MyCmd/Command/exit.pm t/lib/Test/MyCmd/Command/frobulate.pm t/lib/Test/MyCmd/Command/hello.pm t/lib/Test/MyCmd/Command/justusage.pm t/lib/Test/MyCmd/Command/stock.pm t/lib/Test/MyCmd2.pm t/lib/Test/MyCmd2/Command/foo.pm t/lib/Test/MyCmd2/Command/foo/bar.pm t/lib/Test/MyCmdAbbrev.pm t/lib/Test/MyCmdAbbrev/Command/bar.pm t/lib/Test/MyCmdAbbrev/Command/baz.pm t/lib/Test/MyCmdAbbrev/Command/foo.pm t/lib/Test/MySimple.pm t/lib/Test/WSNCC.pm t/lib/Test/WSNCC/Command/blort.pm t/lib/Test/WSOF.pm t/lib/Test/WithCallback.pm t/lib/Test/WithCallback/Command/lol.pm t/lib/Test/WithSetup.pm t/lib/Test/WithSetup/Command.pm t/lib/Test/WithSetup/Command/alfie.pm t/lib/Test/WithSetup/Command/bertie.pm t/lib/Test/XyzzyPlugin.pm t/lib/lol.pl t/setup-broken.t t/setup-ignored.t t/setup-inner.t t/setup-nocmd.t t/setup.t t/simple-args.t t/simple-help.t t/simple-require.t t/simple-use.t t/subdispatch.t xt/release/changes_has_content.t xt/release/pod-syntax.t t000755000766000024 012250623320 12346 5ustar00rjbsstaff000000000000App-Cmd-0.323basic.t100644000766000024 357712250623320 13770 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More tests => 15; use App::Cmd::Tester; use lib 't/lib'; use Test::MyCmd; my $app = Test::MyCmd->new; isa_ok($app, 'Test::MyCmd'); is_deeply( [ sort $app->command_names ], [ sort qw(help --help -h --version -? commands exit frob frobulate hello justusage stock version) ], "got correct list of registered command names", ); is_deeply( [ sort $app->command_plugins ], [ qw( App::Cmd::Command::commands App::Cmd::Command::help App::Cmd::Command::version Test::MyCmd::Command::exit Test::MyCmd::Command::frobulate Test::MyCmd::Command::hello Test::MyCmd::Command::justusage Test::MyCmd::Command::stock ) ], "got correct list of registered command plugins", ); { local @ARGV = qw(frob --widget wname your fat face); eval { $app->run }; is( $@, "the widget name is wname - your fat face\n", "command died with the correct string", ); } { local @ARGV = qw(justusage); eval { $app->run }; my $error = $@; like( $error, qr/^basic.t justusage/, "default usage_desc is okay", ); } { local @ARGV = qw(stock); eval { $app->run }; like($@, qr/mandatory method/, "un-subclassed &run leads to death"); } my $return = test_app('Test::MyCmd', [ qw(--version) ]); my $version_expect = "basic.t (Test::MyCmd) version 0.123 (t/basic.t)\n"; is($return->stdout, $version_expect, "version plugin enabled"); $return = test_app('Test::MyCmd', [ qw(commands) ]); for my $name (qw(commands frobulate hello justusage stock)) { like($return->stdout, qr/^\s+\Q$name\E/sm, "$name plugin in listing"); } unlike($return->stdout, qr/--version/, "version plugin not in listing"); { my $return = test_app('Test::MyCmd', [ qw(exit 1) ]); is($return->exit_code, 1, "exit code is 1"); } { my $return = test_app('Test::MyCmd', [ qw(unknown) ]); is($return->exit_code, 1, "exit code is 1"); } setup.t100644000766000024 214012250623320 14030 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More 'no_plan'; use lib 't/lib'; my $CLASS = 'Test::WithSetup'; require_ok($CLASS); ok($CLASS->isa('App::Cmd'), "$CLASS subclasses App::Cmd"); my $app = $CLASS->new; is_deeply( [ sort $app->command_names ], [ sort qw(help --help -h --version -? commands alfie bertie version) ], "got correct list of registered command names", ); is_deeply( [ sort $app->command_plugins ], [ qw( App::Cmd::Command::commands App::Cmd::Command::help App::Cmd::Command::version Test::WithSetup::Command::alfie Test::WithSetup::Command::bertie ) ], "got correct list of registered command plugins", ); { local @ARGV = qw(alfie); my $return = eval { $app->run }; is_deeply( $return, {}, "basically run", ); } { local @ARGV = qw(bertie); my $return = eval { $app->run }; is($return->[0], 'Test::XyzzyPlugin', "arg0 = plugin itself"); isa_ok($return->[1], 'Test::WithSetup::Command'); isa_ok($return->[1], 'Test::WithSetup::Command::bertie'); is_deeply( $return->[2], [ qw(foo bar) ], "expected args", ); } META.json100644000766000024 3264512250623320 13716 0ustar00rjbsstaff000000000000App-Cmd-0.323{ "abstract" : "write command line apps with less suffering", "author" : [ "Ricardo Signes " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "App-Cmd", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Test::Pod" : "1.41", "version" : "0.9901" } }, "runtime" : { "requires" : { "Capture::Tiny" : "0.13", "Carp" : "0", "Class::Load" : "0.06", "Data::OptList" : "0", "File::Basename" : "0", "Getopt::Long" : "2.39", "Getopt::Long::Descriptive" : "0.084", "IO::TieCombine" : "0", "Module::Pluggable::Object" : "0", "String::RewritePrefix" : "0", "Sub::Exporter" : "0", "Sub::Exporter::Util" : "0", "Sub::Install" : "0", "Text::Abbrev" : "0", "constant" : "0", "parent" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Data::Dumper" : "0", "IPC::Cmd" : "0", "Test::Fatal" : "0", "Test::More" : "0.96", "base" : "0", "lib" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/rjbs/App-Cmd/issues" }, "homepage" : "https://github.com/rjbs/App-Cmd", "repository" : { "type" : "git", "url" : "https://github.com/rjbs/App-Cmd.git", "web" : "https://github.com/rjbs/App-Cmd" } }, "version" : "0.323", "x_Dist_Zilla" : { "perl" : { "version" : "5.018001" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "name" : "@RJBS/Git::GatherDir", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "@RJBS/CheckPrereqsIndexed", "version" : "0.009" }, { "class" : "Dist::Zilla::Plugin::CheckExtraTests", "name" : "@RJBS/CheckExtraTests", "version" : "0.016" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 0, "check_all_prereqs" : 0, "modules" : [ "Dist::Zilla::PluginBundle::RJBS" ], "phase" : "build", "skip" : [] } }, "name" : "@RJBS/RJBS-Outdated", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : "1", "check_all_prereqs" : 0, "modules" : [], "phase" : "release", "skip" : [] } }, "name" : "@RJBS/CPAN-Outdated", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@RJBS/@Filter/PruneCruft", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@RJBS/@Filter/ManifestSkip", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@RJBS/@Filter/MetaYAML", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@RJBS/@Filter/License", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "@RJBS/@Filter/Readme", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@RJBS/@Filter/ExecDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@RJBS/@Filter/ShareDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "name" : "@RJBS/@Filter/MakeMaker", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@RJBS/@Filter/Manifest", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@RJBS/@Filter/TestRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@RJBS/@Filter/ConfirmRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@RJBS/@Filter/UploadToCPAN", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@RJBS/AutoPrereqs", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "name" : "@RJBS/Git::NextVersion", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "@RJBS/PkgVersion", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@RJBS/MetaConfig", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@RJBS/MetaJSON", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@RJBS/NextRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "@RJBS/Test::ChangesHasContent", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@RJBS/PodSyntaxTests", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ReportVersions::Tiny", "name" : "@RJBS/ReportVersions::Tiny", "version" : "1.10" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@RJBS/TestMoreWithSubtests", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "config" : { "Dist::Zilla::Plugin::PodWeaver" : { "config_plugin" : "@RJBS", "finder" : [ ":InstallModules", ":ExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.004" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.004" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@RJBS/SingleEncoding", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@RJBS/Name", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@RJBS/Version", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@RJBS/Prelude", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Synopsis", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Description", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Overview", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Stability", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Attributes", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Methods", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Functions", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@RJBS/Leftovers", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@RJBS/postlude", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@RJBS/Authors", "version" : "4.004" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@RJBS/Legal", "version" : "4.004" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@RJBS/List", "version" : "4.004" } ] } }, "name" : "@RJBS/PodWeaver", "version" : "4.002" }, { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "@RJBS/GithubMeta", "version" : "0.42" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "name" : "@RJBS/@Git/Check", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "name" : "@RJBS/@Git/Commit", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "name" : "@RJBS/@Git/Tag", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "name" : "@RJBS/@Git/Push", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "5.006" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : "0" }, "version" : "5.006" } } } abbrev.t100644000766000024 62512250623320 14117 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More tests => 1; use App::Cmd::Tester; use lib 't/lib'; use Test::MyCmdAbbrev; my $app = Test::MyCmdAbbrev->new( { no_commands_plugin => 1, no_help_plugin => 1, no_version_plugin => 1, } ); is_deeply( [ sort $app->command_names ], [ sort qw{ foo fo f bar baz } ], "got correct list of abbreviated registered command names", ); 00-load.t100644000766000024 43112250623320 14005 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use Test::More tests => 5; BEGIN { use_ok( 'App::Cmd' ); use_ok( 'App::Cmd::Command' ); use_ok( 'App::Cmd::Command::commands' ); use_ok( 'App::Cmd::Subdispatch' ); use_ok( 'App::Cmd::Subdispatch::DashedStyle' ); } diag( "Testing App::Cmd $App::Cmd::VERSION" ); Makefile.PL100644000766000024 405112250623320 14215 0ustar00rjbsstaff000000000000App-Cmd-0.323 use strict; use warnings; use 5.006; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "write command line apps with less suffering", "AUTHOR" => "Ricardo Signes ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "App-Cmd", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "App::Cmd", "PREREQ_PM" => { "Capture::Tiny" => "0.13", "Carp" => 0, "Class::Load" => "0.06", "Data::OptList" => 0, "File::Basename" => 0, "Getopt::Long" => "2.39", "Getopt::Long::Descriptive" => "0.084", "IO::TieCombine" => 0, "Module::Pluggable::Object" => 0, "String::RewritePrefix" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sub::Install" => 0, "Text::Abbrev" => 0, "constant" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Data::Dumper" => 0, "IPC::Cmd" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "base" => 0, "lib" => 0 }, "VERSION" => "0.323", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Capture::Tiny" => "0.13", "Carp" => 0, "Class::Load" => "0.06", "Data::Dumper" => 0, "Data::OptList" => 0, "File::Basename" => 0, "Getopt::Long" => "2.39", "Getopt::Long::Descriptive" => "0.084", "IO::TieCombine" => 0, "IPC::Cmd" => 0, "Module::Pluggable::Object" => 0, "String::RewritePrefix" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sub::Install" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "Text::Abbrev" => 0, "base" => 0, "constant" => 0, "lib" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); callback.t100644000766000024 127712250623320 14436 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More 'no_plan'; use App::Cmd::Tester; use lib 't/lib'; my $CLASS = 'Test::WithCallback'; require_ok($CLASS); ok($CLASS->isa('App::Cmd'), "$CLASS subclasses App::Cmd"); my $app = $CLASS->new; is_deeply( [ sort $app->command_names ], [ sort qw(help --help -h --version -? commands lol version) ], "got correct list of registered command names", ); my $return = test_app('Test::WithCallback', [ qw(lol -e 2) ]); is($return->stdout, 'yay', "Callback validated correctly"); $return = test_app('Test::WithCallback', [ qw(lol -e 1) ]); like( $return->error, qr/even.+valid.email/, "Failing Params::Validate callback prints nice error message" ); lib000755000766000024 012250623320 13114 5ustar00rjbsstaff000000000000App-Cmd-0.323/tlol.pl100644000766000024 6112250623320 14334 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/libuse Test::WithCallback; Test::WithCallback->run App000755000766000024 012250623320 13371 5ustar00rjbsstaff000000000000App-Cmd-0.323/libCmd.pm100644000766000024 3756412250623320 14631 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/Appuse strict; use warnings; use 5.006; package App::Cmd; { $App::Cmd::VERSION = '0.323'; } use App::Cmd::ArgProcessor; BEGIN { our @ISA = 'App::Cmd::ArgProcessor' }; # ABSTRACT: write command line apps with less suffering use File::Basename (); use Module::Pluggable::Object (); use Class::Load (); use Sub::Exporter -setup => { collectors => { -ignore => \'_setup_ignore', -command => \'_setup_command', -run => sub { warn "using -run to run your command is deprecated\n"; $_[1]->{class}->run; 1 }, }, }; sub _setup_command { my ($self, $val, $data) = @_; my $into = $data->{into}; Carp::confess "App::Cmd -command setup requested for already-setup class" if $into->isa('App::Cmd::Command'); { my $base = $self->_default_command_base; Class::Load::load_class($base); no strict 'refs'; push @{"$into\::ISA"}, $base; } $self->_register_command($into); for my $plugin ($self->_plugin_plugins) { $plugin->import_from_plugin({ into => $into }); } 1; } sub _setup_ignore { my ($self, $val, $data ) = @_; my $into = $data->{into}; Carp::confess "App::Cmd -ignore setup requested for already-setup class" if $into->isa('App::Cmd::Command'); $self->_register_ignore($into); 1; } sub _plugin_plugins { return } sub new { my ($class, $arg) = @_; my $arg0 = $0; my $base = File::Basename::basename $arg0; my $self = { command => $class->_command($arg), arg0 => $base, full_arg0 => $arg0, }; bless $self => $class; } # effectively, returns the command-to-plugin mapping guts of a Cmd # if called on a class or on a Cmd with no mapping, construct a new hashref # suitable for use as the object's mapping sub _command { my ($self, $arg) = @_; return $self->{command} if ref $self and $self->{command}; # TODO _default_command_base can be wrong if people are not using # ::Setup and have no ::Command :( # # my $want_isa = $self->_default_command_base; # -- kentnl, 2010-12 my $want_isa = 'App::Cmd::Command'; my %plugin; for my $plugin ($self->_plugins) { Class::Load::load_class($plugin); # relies on either the plugin itself registering as ignored # during compile ( use MyApp::Cmd -ignore ) # or being explicitly registered elsewhere ( blacklisted ) # via $app_cmd->_register_ignore( $class ) # -- kentnl, 2011-09 next if $self->should_ignore( $plugin ); die "$plugin is not a " . $want_isa unless $plugin->isa($want_isa); next unless $plugin->can("command_names"); foreach my $command (map { lc } $plugin->command_names) { die "two plugins for command $command: $plugin and $plugin{$command}\n" if exists $plugin{$command}; $plugin{$command} = $plugin; } } $self->_load_default_plugin($_, $arg, \%plugin) for qw(commands help version); if ($self->allow_any_unambiguous_abbrev) { # add abbreviations to list of authorized commands require Text::Abbrev; my %abbrev = Text::Abbrev::abbrev( keys %plugin ); @plugin{ keys %abbrev } = @plugin{ values %abbrev }; } return \%plugin; } # ->_plugins won't be called more than once on any given App::Cmd, but since # finding plugins can be a bit expensive, we'll do a lousy cache here. # -- rjbs, 2007-10-09 my %plugins_for; sub _plugins { my ($self) = @_; my $class = ref $self || $self; return @{ $plugins_for{$class} } if $plugins_for{$class}; my $finder = Module::Pluggable::Object->new( search_path => $self->plugin_search_path, $self->_module_pluggable_options, ); my @plugins = $finder->plugins; $plugins_for{$class} = \@plugins; return @plugins; } sub _register_command { my ($self, $cmd_class) = @_; $self->_plugins; my $class = ref $self || $self; push @{ $plugins_for{ $class } }, $cmd_class unless grep { $_ eq $cmd_class } @{ $plugins_for{ $class } }; } my %ignored_for; sub should_ignore { my ( $self , $cmd_class ) = @_; my $class = ref $self || $self; for ( @{ $ignored_for{ $class } } ) { return 1 if $_ eq $cmd_class; } return; } sub _register_ignore { my ($self, $cmd_class) = @_; my $class = ref $self || $self; push @{ $ignored_for{ $class } }, $cmd_class unless grep { $_ eq $cmd_class } @{ $ignored_for{ $class } }; } sub _module_pluggable_options { # my ($self) = @_; # no point in creating these ops, just to toss $self return; } # load one of the stock plugins, unless requested to squash; unlike normal # plugin loading, command-to-plugin mapping conflicts are silently ignored sub _load_default_plugin { my ($self, $plugin_name, $arg, $plugin_href) = @_; unless ($arg->{"no_$plugin_name\_plugin"}) { my $plugin = "App::Cmd::Command::$plugin_name"; Class::Load::load_class($plugin); for my $command (map { lc } $plugin->command_names) { $plugin_href->{$command} ||= $plugin; } } } sub run { my ($self) = @_; # We should probably use Class::Default. $self = $self->new unless ref $self; # prepare the command we're going to run... my @argv = $self->prepare_args(); my ($cmd, $opt, @args) = $self->prepare_command(@argv); # ...and then run it $self->execute_command($cmd, $opt, @args); } sub prepare_args { my ($self) = @_; return scalar(@ARGV) ? (@ARGV) : (@{$self->default_args}); } use constant default_args => []; sub arg0 { $_[0]->{arg0} } sub full_arg0 { $_[0]->{full_arg0} } sub prepare_command { my ($self, @args) = @_; # figure out first-level dispatch my ($command, $opt, @sub_args) = $self->get_command(@args); # set up the global options (which we just determined) $self->set_global_options($opt); # find its plugin or else call default plugin (default default is help) if ($command) { $self->_prepare_command($command, $opt, @sub_args); } else { $self->_prepare_default_command($opt, @sub_args); } } sub _prepare_command { my ($self, $command, $opt, @args) = @_; if (my $plugin = $self->plugin_for($command)) { return $plugin->prepare($self, @args); } else { return $self->_bad_command($command, $opt, @args); } } sub _prepare_default_command { my ($self, $opt, @sub_args) = @_; $self->_prepare_command($self->default_command, $opt, @sub_args); } sub _bad_command { my ($self, $command, $opt, @args) = @_; print "Unrecognized command: $command.\n\nUsage:\n" if defined($command); # This should be class data so that, in Bizarro World, two App::Cmds will not # conflict. our $_bad++; $self->prepare_command(qw(commands --stderr)); } END { exit 1 if our $_bad }; sub default_command { "help" } sub execute_command { my ($self, $cmd, $opt, @args) = @_; local our $active_cmd = $cmd; $cmd->validate_args($opt, \@args); $cmd->execute($opt, \@args); } sub _default_command_base { my ($self) = @_; my $class = ref $self || $self; return "$class\::Command"; } sub _default_plugin_base { my ($self) = @_; my $class = ref $self || $self; return "$class\::Plugin"; } sub plugin_search_path { my ($self) = @_; my $dcb = $self->_default_command_base; my $ccb = $dcb eq 'App::Cmd::Command' ? $self->App::Cmd::_default_command_base : $self->_default_command_base; my @default = ($ccb, $self->_default_plugin_base); if (ref $self) { return $self->{plugin_search_path} ||= \@default; } else { return \@default; } } sub allow_any_unambiguous_abbrev { return 0 } sub global_options { my $self = shift; return $self->{global_options} ||= {} if ref $self; return {}; } sub set_global_options { my ($self, $opt) = @_; return $self->{global_options} = $opt; } sub command_names { my ($self) = @_; keys %{ $self->_command }; } sub command_plugins { my ($self) = @_; my %seen = map {; $_ => 1 } values %{ $self->_command }; keys %seen; } sub plugin_for { my ($self, $command) = @_; return unless $command; return unless exists $self->_command->{ $command }; return $self->_command->{ $command }; } sub get_command { my ($self, @args) = @_; my ($opt, $args, %fields) = $self->_process_args(\@args, $self->_global_option_processing_params); my ($command, $rest) = $self->_cmd_from_args($args); $self->{usage} = $fields{usage}; return ($command, $opt, @$rest); } sub _cmd_from_args { my ($self, $args) = @_; my $command = shift @$args; return ($command, $args); } sub _global_option_processing_params { my ($self, @args) = @_; return ( $self->usage_desc(@args), $self->global_opt_spec(@args), { getopt_conf => [qw/pass_through/] }, ); } sub usage { $_[0]{usage} }; sub usage_desc { # my ($self) = @_; # no point in creating these ops, just to toss $self return "%c %o"; } sub global_opt_spec { # my ($self) = @_; # no point in creating these ops, just to toss $self return; } sub usage_error { my ($self, $error) = @_; die "Error: $error\nUsage: " . $self->_usage_text; } sub _usage_text { my ($self) = @_; my $text = $self->usage->text; $text =~ s/\A(\s+)/!/; return $text; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd - write command line apps with less suffering =head1 VERSION version 0.323 =head1 SYNOPSIS in F: use YourApp; YourApp->run; in F: package YourApp; use App::Cmd::Setup -app; 1; in F: package YourApp::Command::blort; use YourApp -command; use strict; use warnings; sub opt_spec { return ( [ "blortex|X", "use the blortex algorithm" ], [ "recheck|r", "recheck all results" ], ); } sub validate_args { my ($self, $opt, $args) = @_; # no args allowed but options! $self->usage_error("No args allowed") if @$args; } sub execute { my ($self, $opt, $args) = @_; my $result = $opt->{blortex} ? blortex() : blort(); recheck($result) if $opt->{recheck}; print $result; } and, finally, at the command line: knight!rjbs$ yourcmd blort --recheck All blorts successful. =head1 DESCRIPTION App::Cmd is intended to make it easy to write complex command-line applications without having to think about most of the annoying things usually involved. For information on how to start using App::Cmd, see L. =head1 METHODS =head2 new my $cmd = App::Cmd->new(\%arg); This method returns a new App::Cmd object. During initialization, command plugins will be loaded. Valid arguments are: no_commands_plugin - if true, the command list plugin is not added no_help_plugin - if true, the help plugin is not added no_version_plugin - if true, the version plugin is not added plugin_search_path - The path to search for commands in. Defaults to results of plugin_search_path method If C is not given, L will be required, and it will be registered to handle all of its command names not handled by other plugins. If C is not given, L will be required, and it will be registered to handle all of its command names not handled by other plugins. B "help" is the default command, so if you do not load the default help plugin, you should provide your own or override the C method. If C is not given, L will be required to show the application's version with command C<--version>. The version command is not included in the command list. =head2 run $cmd->run; This method runs the application. If called the class, it will instantiate a new App::Cmd object to run. It determines the requested command (generally by consuming the first command-line argument), finds the plugin to handle that command, parses the remaining arguments according to that plugin's rules, and runs the plugin. It passes the contents of the global argument array (C<@ARGV>) to L>, but C<@ARGV> is not altered by running an App::Cmd. =head2 prepare_args Normally App::Cmd uses C<@ARGV> for its commandline arguments. You can override this method to change that behavior for testing or otherwise. =head2 default_args If C> is not changed and there are no arguments in C<@ARGV>, this method is called and should return an arrayref to be used as the arguments to the program. By default, it returns an empty arrayref. =head2 arg0 =head2 full_arg0 my $program_name = $app->arg0; my $full_program_name = $app->full_arg0; These methods return the name of the program invoked to run this application. This is determined by inspecting C<$0> when the App::Cmd object is instantiated, so it's probably correct, but doing weird things with App::Cmd could lead to weird values from these methods. If the program was run like this: knight!rjbs$ ~/bin/rpg dice 3d6 Then the methods return: arg0 - rpg full_arg0 - /Users/rjbs/bin/rpg These values are captured when the App::Cmd object is created, so it is safe to assign to C<$0> later. =head2 prepare_command my ($cmd, $opt, @args) = $app->prepare_command(@ARGV); This method will load the plugin for the requested command, use its options to parse the command line arguments, and eventually return everything necessary to actually execute the command. =head2 default_command This method returns the name of the command to run if none is given on the command line. The default default is "help" =head2 execute_command $app->execute_command($cmd, \%opt, @args); This method will invoke C and then C on C<$cmd>. =head2 plugin_search_path This method returns the plugin_search_path as set. The default implementation, if called on "YourApp::Cmd" will return "YourApp::Cmd::Command" This is a method because it's fun to override it with, for example: use constant plugin_search_path => __PACKAGE__; =head2 allow_any_unambiguous_abbrev If this method returns true (which, by default, it does I), then any unambiguous abbreviation for a registered command name will be allowed as a means to use that command. For example, given the following commands: reticulate reload rasterize Then the user could use C for C or C for C and so on. =head2 global_options if ($cmd->app->global_options->{verbose}) { ... } This method returns the running application's global options as a hashref. If there are no options specified, an empty hashref is returned. =head2 set_global_options $app->set_global_options(\%opt); This method sets the global options. =head2 command_names my @names = $cmd->command_names; This returns the commands names which the App::Cmd object will handle. =head2 command_plugins my @plugins = $cmd->command_plugins; This method returns the package names of the plugins that implement the App::Cmd object's commands. =head2 plugin_for my $plugin = $cmd->plugin_for($command); This method returns the plugin (module) for the given command. If no plugin implements the command, it returns false. =head2 get_command my ($command_name, $opt, @args) = $app->get_command(@args); Process arguments and into a command name and (optional) global options. =head2 usage print $self->app->usage->text; Returns the usage object for the global options. =head2 usage_desc The top level usage line. Looks something like "yourapp [options]" =head2 global_opt_spec Returns an empty list. Can be overridden for pre-dispatch option processing. This is useful for flags like --verbose. =head2 usage_error $self->usage_error("Something's wrong!"); Used to die with nice usage output, during C. =head1 TODO =over 4 =item * publish and bring in Log::Speak (simple quiet/verbose output) =item * publish and use our internal enhanced describe_options =item * publish and use our improved simple input routines =back =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut simple-use.t100644000766000024 60612250623320 14740 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More tests => 1; use App::Cmd::Tester; use lib 't/lib'; use Test::MySimple; my $return = test_app('Test::MySimple', [ qw(bite the wax tadpole) ]); # Horrible hack. -- rjbs, 2009-06-27 my $stdout = $return->stdout; my $struct = eval $stdout; is_deeply( $struct, [ { }, [ qw(bite the wax tadpole) ] ], "our simple app runs properly", ); capture-ext.t100644000766000024 51512250623320 15115 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More tests => 2; use App::Cmd::Tester::CaptureExternal; use lib 't/lib'; use Test::MyCmd; my $app = Test::MyCmd->new; isa_ok($app, 'Test::MyCmd'); my $return = test_app('Test::MyCmd', [ qw(hello) ]); like( $return->output, qr/Hello World/, "Captured external subcommand output" ); setup-inner.t100644000766000024 136112250623320 15145 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More 'no_plan'; use lib 't/lib'; my $CLASS = 'Test::WSOF'; require_ok($CLASS); ok($CLASS->isa('App::Cmd'), "$CLASS subclasses App::Cmd"); my $app = $CLASS->new; is_deeply( [ sort $app->command_names ], [ sort qw(help --help -h --version -? commands poot version) ], "got correct list of registered command names", ); is_deeply( [ sort $app->command_plugins ], [ qw( App::Cmd::Command::commands App::Cmd::Command::help App::Cmd::Command::version Test::WSOF::Command::poot ) ], "got correct list of registered command plugins", ); { local @ARGV = qw(poot); my $return = eval { $app->run }; is($return, 'woof woof poot', "inner package commands work with Setup"); } setup-nocmd.t100644000766000024 177512250623320 15143 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; # This should be valid: # # package MyApp; use App::Cmd::Setup -app; # package MyApp::Command::foo; use MyApp -command; # # then using MyApp should still load everything under MyApp::Command, even # though we didn't do: # package MyApp::Command; use App::Cmd::Setup -command; use Test::More 'no_plan'; use lib 't/lib'; my $CLASS = 'Test::WSNCC'; require_ok($CLASS); ok($CLASS->isa('App::Cmd'), "$CLASS subclasses App::Cmd"); my $app = $CLASS->new; is_deeply( [ sort $app->command_names ], [ sort qw(help --help -h --version -? commands blort version) ], "got correct list of registered command names", ); is_deeply( [ sort $app->command_plugins ], [ qw( App::Cmd::Command::commands App::Cmd::Command::help App::Cmd::Command::version Test::WSNCC::Command::blort ) ], "got correct list of registered command plugins", ); { local @ARGV = qw(blort); my $return = eval { $app->run }; is_deeply( $return, {}, "basically run", ); } simple-args.t100644000766000024 44012250623320 15074 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More tests => 1; use App::Cmd::Tester; use lib 't/lib'; use Test::MySimple; my $return = test_app('Test::MySimple', [ ]); my $error = $return->error; like( $error, qr/^Error: not enough args/, "our simple app fails without args", ); simple-help.t100644000766000024 127412250623320 15116 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More; use App::Cmd::Tester; use lib 't/lib'; use Test::MySimple; my $return = test_app('Test::MySimple', [ qw(--help) ]); my $stdout = $return->stdout; like( $stdout, qr/\S/, "Our simple app prints some help text.", ); like( $stdout, qr/\[-f\]\s+\[long options\.\.\.\]/, "Our simple app prints a usage message", ); my $option_help_regex = join('\s+', qw(-f --fooble check all foobs for foobling)); like( $stdout, qr/$option_help_regex/, "Our simple app prints the help text for --fooble option", ); unlike( $stdout, qr/commands/i, "Our simple app doesn't talk about subcommands", ); done_testing() subdispatch.t100644000766000024 116112250623320 15203 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use lib 't/lib'; BEGIN { use_ok('Test::MyCmd2') }; my $app = Test::MyCmd2->new({}); my ( $cmd, $opt, @args ) = $app->prepare_command(qw/--verbose foo --moose bar --foo/); is_deeply( $app->global_options, { verbose => 1 }, "global opts" ); isa_ok( $cmd, "App::Cmd::Command" ); is( ($cmd->command_names)[0], "bar", "dispatched to a nested command" ); isa_ok( $cmd->app, "App::Cmd::Subdispatch" ); is_deeply( $cmd->app->global_options, { moose => 1 }, "subdispatcher global options" ); is_deeply( \@args, [] ); is_deeply( $opt, { foo => => 1 } ); setup-broken.t100644000766000024 145012250623320 15311 0ustar00rjbsstaff000000000000App-Cmd-0.323/tuse strict; use warnings; use Test::More 0.88; use Test::Fatal; use lib 't/lib'; ok( !exists $INC{'Test/BrokenCmd/Command.pm'}, 'Broken library not tried to load yet' ); ok( !exists $INC{'Test/BrokenCmd/Command::Notthere.pm'}, 'Missing library not tried to load yet' ); isnt( exception { require Test::BrokenCmd; }, undef, 'using an obviously broken library should die' ); { local $TODO = "require 'works' after failing on pre-5.10" if $] < 5.010; isnt( exception { require Test::BrokenCmd::Command; }, undef, 'the broken library is broken' ); } ok( exists $INC{'Test/BrokenCmd/Command.pm'}, 'Broken library tried to load' ); ok( !exists $INC{'Test/BrokenCmd/Command::Notthere.pm'}, 'Missing library not tried to load yet' ); done_testing; setup-ignored.t100644000766000024 47112250623320 15442 0ustar00rjbsstaff000000000000App-Cmd-0.323/tuse strict; use warnings; use Test::More 0.88; use Test::Fatal; use lib 't/lib'; is( exception { require Test::IgnoreCommand; }, undef, 'Ignored Commands shouldn\'t be fatal' ); my @plugins = Test::IgnoreCommand->_plugins(); is_deeply( \@plugins, [] , 'no commands were loaded' ); done_testing; Test000755000766000024 012250623320 14033 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/libWSOF.pm100644000766000024 40012250623320 15261 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; # WSOF: with Setup, one file package Test::WSOF; use App::Cmd::Setup -app => { plugins => [ qw(=Test::XyzzyPlugin) ], }; package Test::WSOF::Command::poot; use Test::WSOF -command; sub execute { return 'woof woof poot' } 1; simple-require.t100644000766000024 62012250623320 15614 0ustar00rjbsstaff000000000000App-Cmd-0.323/t#!perl use strict; use warnings; use Test::More tests => 1; use App::Cmd::Tester; use lib 't/lib'; require Test::MySimple; my $return = test_app(Test::MySimple->import, [ qw(bite the wax tadpole) ]); # Horrible hack. -- rjbs, 2009-06-27 my $stdout = $return->stdout; my $struct = eval $stdout; is_deeply( $struct, [ { }, [ qw(bite the wax tadpole) ] ], "our simple app runs properly", ); MyCmd.pm100644000766000024 14512250623320 15522 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testpackage Test::MyCmd; use strict; use warnings; use base qw(App::Cmd); our $VERSION = '0.123'; 1; WSNCC.pm100644000766000024 17612250623320 15372 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; package Test::WSNCC; use App::Cmd::Setup -app => { plugins => [ qw(=Test::XyzzyPlugin) ], }; 1; Cmd000755000766000024 012250623320 14074 5ustar00rjbsstaff000000000000App-Cmd-0.323/lib/AppSetup.pm100644000766000024 1257312250623320 15722 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::Setup; { $App::Cmd::Setup::VERSION = '0.323'; } # ABSTRACT: helper for setting up App::Cmd classes use App::Cmd (); use App::Cmd::Command (); use App::Cmd::Plugin (); use Carp (); use Data::OptList (); use String::RewritePrefix (); # 0.06 is needed for load_optional_class use Class::Load 0.06 qw(); use Sub::Exporter -setup => { -as => '_import', exports => [ qw(foo) ], collectors => [ -app => \'_make_app_class', -command => \'_make_command_class', -plugin => \'_make_plugin_class', ], }; sub import { goto &_import; } sub _app_base_class { 'App::Cmd' } sub _make_app_class { my ($self, $val, $data) = @_; my $into = $data->{into}; $val ||= {}; Carp::confess "invalid argument to -app setup" if grep { $_ ne 'plugins' } keys %$val; Carp::confess "app setup requested on App::Cmd subclass $into" if $into->isa('App::Cmd'); $self->_make_x_isa_y($into, $self->_app_base_class); if ( ! Class::Load::load_optional_class( $into->_default_command_base ) ) { my $base = $self->_command_base_class; Sub::Install::install_sub({ code => sub { $base }, into => $into, as => '_default_command_base', }); } # TODO Check this is right. -- kentnl, 2010-12 # # my $want_plugin_base = $self->_plugin_base_class; my $want_plugin_base = 'App::Cmd::Plugin'; my @plugins; for my $plugin (@{ $val->{plugins} || [] }) { $plugin = String::RewritePrefix->rewrite( { '' => 'App::Cmd::Plugin::', '=' => '' }, $plugin, ); Class::Load::load_class( $plugin ); unless( $plugin->isa( $want_plugin_base ) ){ die "$plugin is not a " . $want_plugin_base; } push @plugins, $plugin; } Sub::Install::install_sub({ code => sub { @plugins }, into => $into, as => '_plugin_plugins', }); return 1; } sub _command_base_class { 'App::Cmd::Command' } sub _make_command_class { my ($self, $val, $data) = @_; my $into = $data->{into}; Carp::confess "command setup requested on App::Cmd::Command subclass $into" if $into->isa('App::Cmd::Command'); $self->_make_x_isa_y($into, $self->_command_base_class); return 1; } sub _make_x_isa_y { my ($self, $x, $y) = @_; no strict 'refs'; push @{"$x\::ISA"}, $y; } sub _plugin_base_class { 'App::Cmd::Plugin' } sub _make_plugin_class { my ($self, $val, $data) = @_; my $into = $data->{into}; Carp::confess "plugin setup requested on App::Cmd::Plugin subclass $into" if $into->isa('App::Cmd::Plugin'); Carp::confess "plugin setup requires plugin configuration" unless $val; $self->_make_x_isa_y($into, $self->_plugin_base_class); # In this special case, exporting everything by default is the sensible thing # to do. -- rjbs, 2008-03-31 $val->{groups} = [ default => [ -all ] ] unless $val->{groups}; my @exports; for my $pair (@{ Data::OptList::mkopt($val->{exports}) }) { push @exports, $pair->[0], ($pair->[1] || \'_faux_curried_method'); } $val->{exports} = \@exports; Sub::Exporter::setup_exporter({ %$val, into => $into, as => 'import_from_plugin', }); return 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Setup - helper for setting up App::Cmd classes =head1 VERSION version 0.323 =head1 OVERVIEW App::Cmd::Setup is a helper library, used to set up base classes that will be used as part of an App::Cmd program. For the most part you should refer to L for how you should use this library. This class is useful in three scenarios: =over 4 =item when writing your App::Cmd subclass Instead of writing: package MyApp; use base 'App::Cmd'; ...you can write: package MyApp; use App::Cmd::Setup -app; The benefits of doing this are mostly minor, and relate to sanity-checking your class. The significant benefit is that this form allows you to specify plugins, as in: package MyApp; use App::Cmd::Setup -app => { plugins => [ 'Prompt' ] }; Plugins are described in L and L. =item when writing abstract base classes for commands That is: when you write a subclass of L that is intended for other commands to use as their base class, you should use App::Cmd::Setup. For example, if you want all the commands in MyApp to inherit from MyApp::Command, you may want to write that package like this: package MyApp::Command; use App::Cmd::Setup -command; Do not confuse this with the way you will write specific commands: package MyApp::Command::mycmd; use MyApp -command; Again, this form mostly performs some validation and setup behind the scenes for you. You can use C> if you prefer. =item when writing App::Cmd plugins L is a mechanism that allows an App::Cmd class to inject code into all its command classes, providing them with utility routines. To write a plugin, you must use App::Cmd::Setup. As seen above, you must also use App::Cmd::Setup to set up your App::Cmd subclass if you wish to consume plugins. For more information on writing plugins, see L and L. =back =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut MyCmd2.pm100644000766000024 20712250623320 15603 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testpackage Test::MyCmd2; use strict; use warnings; use base qw(App::Cmd); sub global_opt_spec { [ 'verbose+' => "Verbosity" ], } 1; Plugin.pm100644000766000024 126612250623320 16035 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::Plugin; { $App::Cmd::Plugin::VERSION = '0.323'; } # ABSTRACT: a plugin for App::Cmd commands sub _faux_curried_method { my ($class, $name, $arg) = @_; return sub { my $cmd = $App::Cmd::active_cmd; $class->$name($cmd, @_); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Plugin - a plugin for App::Cmd commands =head1 VERSION version 0.323 =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Simple.pm100644000766000024 1316512250623320 16051 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::Simple; { $App::Cmd::Simple::VERSION = '0.323'; } use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command' } # ABSTRACT: a helper for building one-command App::Cmd applications use App::Cmd; use Sub::Install; # The idea here is that the user will someday replace "Simple" in his ISA with # "Command" and then write a standard App::Cmd package. To make that possible, # we produce a behind-the-scenes App::Cmd object when the user says 'use # MyApp::Simple' and redirect MyApp::Simple->run to that. my $i; BEGIN { $i = 0 } sub import { my ($class) = @_; return if $class eq __PACKAGE__; # This signals that something has already set the target up. return $class if $class->_cmd_pkg; my $core_execute = App::Cmd::Command->can('execute'); my $our_execute = $class->can('execute'); Carp::confess( "App::Cmd::Simple subclasses must implement ->execute, not ->run" ) unless $our_execute and $our_execute != $core_execute; # I doubt the $i will ever be needed, but let's start paranoid. my $generated_name = join('::', $class, '_App_Cmd', $i++); { no strict 'refs'; *{$generated_name . '::ISA'} = [ 'App::Cmd' ]; } Sub::Install::install_sub({ into => $class, as => '_cmd_pkg', code => sub { $generated_name }, }); Sub::Install::install_sub({ into => $class, as => 'command_names', code => sub { 'only' }, }); Sub::Install::install_sub({ into => $generated_name, as => '_plugins', code => sub { $class }, }); Sub::Install::install_sub({ into => $generated_name, as => 'default_command', code => sub { 'only' }, }); Sub::Install::install_sub({ into => $generated_name, as => '_cmd_from_args', code => sub { my ($self, $args) = @_; if (defined(my $command = $args->[0])) { my $plugin = $self->plugin_for($command); # If help was requested, show the help for the command, not the # main help. Because the main help would talk about subcommands, # and a "Simple" app has no subcommands. if ($plugin and $plugin eq $self->plugin_for("help")) { return ($command, [ $self->default_command ]); } # Any other value for "command" isn't really a command at all -- # it's the first argument. So call the default command instead. } return ($self->default_command, $args); }, }); Sub::Install::install_sub({ into => $class, as => 'run', code => sub { $generated_name->new({ no_help_plugin => 0, no_commands_plugin => 1, })->run(@_); } }); return $class; } sub usage_desc { return "%c %o" } sub _cmd_pkg { } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Simple - a helper for building one-command App::Cmd applications =head1 VERSION version 0.323 =head1 SYNOPSIS in F: use YourApp::Cmd; Your::Cmd->run; in F: package YourApp::Cmd; use base qw(App::Cmd::Simple); sub opt_spec { return ( [ "blortex|X", "use the blortex algorithm" ], [ "recheck|r", "recheck all results" ], ); } sub validate_args { my ($self, $opt, $args) = @_; # no args allowed but options! $self->usage_error("No args allowed") if @$args; } sub execute { my ($self, $opt, $args) = @_; my $result = $opt->{blortex} ? blortex() : blort(); recheck($result) if $opt->{recheck}; print $result; } and, finally, at the command line: knight!rjbs$ simplecmd --recheck All blorts successful. =head1 SUBCLASSING When writing a subclass of App::Cmd:Simple, there are only a few methods that you might want to implement. They behave just like the same-named methods in App::Cmd. =head2 opt_spec This method should be overridden to provide option specifications. (This is list of arguments passed to C from Getopt::Long::Descriptive, after the first.) If not overridden, it returns an empty list. =head2 validate_args $cmd->validate_args(\%opt, \@args); This method is passed a hashref of command line options (as processed by Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw an exception (preferably by calling C) if they are invalid, or it may do nothing to allow processing to continue. =head2 execute Your::App::Cmd::Simple->execute(\%opt, \@args); This method does whatever it is the command should do! It is passed a hash reference of the parsed command-line options and an array reference of left over arguments. =head1 WARNINGS B Although it is probably not going to change much, don't build your business model around it yet, okay? App::Cmd::Simple is not rich in black magic, but it does do some somewhat gnarly things to make an App::Cmd::Simple look as much like an App::Cmd::Command as possible. This means that you can't deviate too much from the sort of thing shown in the synopsis as you might like. If you're doing something other than writing a fairly simple command, and you want to screw around with the App::Cmd-iness of your program, Simple might not be the best choice. B if you are writing a program with the App::Cmd::Simple class embedded in it, you B call import on the class. That's how things work. You can just do this: YourApp::Cmd->import->run; =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Tester.pm100644000766000024 1052412250623320 16062 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::Tester; { $App::Cmd::Tester::VERSION = '0.323'; } # ABSTRACT: for capturing the result of running an app use Sub::Exporter::Util qw(curry_method); use Sub::Exporter -setup => { exports => { test_app => curry_method }, groups => { default => [ qw(test_app) ] }, }; our $TEST_IN_PROGRESS; BEGIN { *CORE::GLOBAL::exit = sub { return CORE::exit(@_) unless $TEST_IN_PROGRESS; App::Cmd::Tester::Exited->throw($_[0]); }; } sub result_class { 'App::Cmd::Tester::Result' } sub test_app { my ($class, $app, $argv) = @_; local $App::Cmd::_bad = 0; $app = $app->new unless ref($app) or $app->isa('App::Cmd::Simple'); my $result = $class->_run_with_capture($app, $argv); my $error = $result->{error}; my $exit_code = defined $error ? ((0+$!)||-1) : 0; if ($error and eval { $error->isa('App::Cmd::Tester::Exited') }) { $exit_code = $$error; } $exit_code =1 if $App::Cmd::_bad && ! $exit_code; $class->result_class->new({ app => $app, exit_code => $exit_code, %$result, }); } sub _run_with_capture { my ($class, $app, $argv) = @_; require IO::TieCombine; my $hub = IO::TieCombine->new; my $stdout = tie local *STDOUT, $hub, 'stdout'; my $stderr = tie local *STDERR, $hub, 'stderr'; my $run_rv; my $ok = eval { local $TEST_IN_PROGRESS = 1; local @ARGV = @$argv; $run_rv = $app->run; 1; }; my $error = $ok ? undef : $@; return { stdout => $hub->slot_contents('stdout'), stderr => $hub->slot_contents('stderr'), output => $hub->combined_contents, error => $error, run_rv => $run_rv, }; } { package App::Cmd::Tester::Result; { $App::Cmd::Tester::Result::VERSION = '0.323'; } sub new { my ($class, $arg) = @_; bless $arg => $class; } for my $attr (qw(app stdout stderr output error run_rv exit_code)) { Sub::Install::install_sub({ code => sub { $_[0]->{$attr} }, as => $attr, }); } } { package App::Cmd::Tester::Exited; { $App::Cmd::Tester::Exited::VERSION = '0.323'; } sub throw { my ($class, $code) = @_; $code = 0 unless defined $code; my $self = (bless \$code => $class); die $self; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Tester - for capturing the result of running an app =head1 VERSION version 0.323 =head1 SYNOPSIS use Test::More tests => 4; use App::Cmd::Tester; use YourApp; my $result = test_app(YourApp => [ qw(command --opt value) ]); like($result->stdout, qr/expected output/, 'printed what we expected'); is($result->stderr, '', 'nothing sent to sderr'); is($result->error, undef, 'threw no exceptions'); my $result = test_app(YourApp => [ qw(command --opt value --quiet) ]); is($result->output, '', 'absolutely no output with --quiet'); =head1 DESCRIPTION One of the reasons that user-executed programs are so often poorly tested is that they are hard to test. App::Cmd::Tester is one of the tools App-Cmd provides to help make it easy to test App::Cmd-based programs. It provides one routine: test_app. =head1 METHODS =head2 test_app B: while C is a method, it is by default exported as a subroutine into the namespace that uses App::Cmd::Tester. In other words: you probably don't need to think about this as a method unless you want to subclass App::Cmd::Tester. my $result = test_app($app_class => \@argv_contents); This will locally set C<@ARGV> to simulate command line arguments, and will then call the C method on the given application class (or application). Output to the standard output and standard error filehandles will be captured. C<$result> is an App::Cmd::Tester::Result object, which has methods to access the following data: stdout - the output sent to stdout stderr - the output sent to stderr output - the combined output of stdout and stderr error - the exception thrown by running the application, or undef run_rv - the return value of the run method (generally irrelevant) exit_code - the numeric exit code that would've been issued (0 is 'okay') =for Pod::Coverage result_class =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Command.pm100644000766000024 1354512250623320 16200 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::Command; { $App::Cmd::Command::VERSION = '0.323'; } use App::Cmd::ArgProcessor; BEGIN { our @ISA = 'App::Cmd::ArgProcessor' }; # ABSTRACT: a base class for App::Cmd commands use Carp (); sub prepare { my ($class, $app, @args) = @_; my ($opt, $args, %fields) = $class->_process_args(\@args, $class->_option_processing_params($app)); return ( $class->new({ app => $app, %fields }), $opt, @$args, ); } sub _option_processing_params { my ($class, @args) = @_; return ( $class->usage_desc(@args), $class->opt_spec(@args), ); } sub new { my ($class, $arg) = @_; bless $arg => $class; } sub execute { my $class = shift; if (my $run = $class->can('run')) { warn "App::Cmd::Command subclasses should implement ->execute not ->run" if $ENV{HARNESS_ACTIVE}; return $class->$run(@_); } Carp::croak ref($class) . " does not implement mandatory method 'execute'\n"; } sub app { $_[0]->{app}; } sub usage { $_[0]->{usage}; } sub command_names { # from UNIVERSAL::moniker (ref( $_[0] ) || $_[0]) =~ /([^:]+)$/; return lc $1; } sub usage_desc { my ($self) = @_; my ($command) = $self->command_names; return "%c $command %o" } sub opt_spec { return; } sub validate_args { } sub usage_error { my ( $self, $error ) = @_; die "Error: $error\nUsage: " . $self->_usage_text; } sub _usage_text { my ($self) = @_; local $@; join "\n", eval { $self->app->_usage_text }, eval { $self->usage->text }; } # stolen from ExtUtils::MakeMaker sub abstract { my ($class) = @_; $class = ref $class if ref $class; my $result; my $weaver_abstract; # classname to filename (my $pm_file = $class) =~ s!::!/!g; $pm_file .= '.pm'; $pm_file = $INC{$pm_file} or return "(unknown)"; # if the pm file exists, open it and parse it open my $fh, "<", $pm_file or return "(unknown)"; local $/ = "\n"; my $inpod; while (local $_ = <$fh>) { # =cut toggles, it doesn't end :-/ $inpod = /^=cut/ ? !$inpod : $inpod || /^=(?!cut)/; if (/#+\s*ABSTRACT: (.*)/){ # takes ABSTRACT: ... if no POD defined yet $weaver_abstract = $1; } next unless $inpod; chomp; next unless /^(?:$class\s-\s)(.*)/; $result = $1; last; } return $result || $weaver_abstract || "(unknown)"; } sub description { '' } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Command - a base class for App::Cmd commands =head1 VERSION version 0.323 =head1 METHODS =head2 prepare my ($cmd, $opt, $args) = $class->prepare($app, @args); This method is the primary way in which App::Cmd::Command objects are built. Given the remaining command line arguments meant for the command, it returns the Command object, parsed options (as a hashref), and remaining arguments (as an arrayref). In the usage above, C<$app> is the App::Cmd object that is invoking the command. =head2 new This returns a new instance of the command plugin. Probably only C should use this. =head2 execute $command_plugin->execute(\%opt, \@args); This method does whatever it is the command should do! It is passed a hash reference of the parsed command-line options and an array reference of left over arguments. If no C method is defined, it will try to call C -- but it will warn about this behavior during testing, to remind you to fix the method name! =head2 app This method returns the App::Cmd object into which this command is plugged. =head2 usage This method returns the usage object for this command. (See L). =head2 command_names This method returns a list of command names handled by this plugin. The first item returned is the 'canonical' name of the command. If this method is not overridden by an App::Cmd::Command subclass, it will return the last part of the plugin's package name, converted to lowercase. For example, YourApp::Cmd::Command::Init will, by default, handle the command "init". Subclasses should generally get the superclass value of C and then append aliases. =head2 usage_desc This method should be overridden to provide a usage string. (This is the first argument passed to C from Getopt::Long::Descriptive.) If not overridden, it returns "%c COMMAND %o"; COMMAND is the first item in the result of the C method. =head2 opt_spec This method should be overridden to provide option specifications. (This is list of arguments passed to C from Getopt::Long::Descriptive, after the first.) If not overridden, it returns an empty list. =head2 validate_args $command_plugin->validate_args(\%opt, \@args); This method is passed a hashref of command line options (as processed by Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw an exception (preferably by calling C, below) if they are invalid, or it may do nothing to allow processing to continue. =head2 usage_error $self->usage_error("This command must not be run by root!"); This method should be called to die with human-friendly usage output, during C. =head2 abstract This method returns a short description of the command's purpose. If this method is not overridden, it will return the abstract from the module's Pod. If it can't find the abstract, it will look for a comment starting with "ABSTRACT:" like the ones used by L. =head2 description This method should be overridden to provide full option description. It is used by the built-in L command. If not overridden, it returns an empty string. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut MySimple.pm100644000766000024 63012250623320 16247 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testpackage Test::MySimple; use strict; use warnings; use base 'App::Cmd::Simple'; use Data::Dumper; sub execute { my ($self, $opt, $args) = @_; local $Data::Dumper::Terse = 1; print Dumper([ $opt, $args ]); } sub validate_args { my ($self, $opt, $args) = @_; $self->usage_error("not enough args") unless @$args > 0; } sub opt_spec { return [ "fooble|f", "check all foobs for foobling" ], } 1; BrokenCmd.pm100644000766000024 12212250623320 16350 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; package Test::BrokenCmd; use App::Cmd::Setup -app; 1; WithSetup.pm100644000766000024 20212250623320 16437 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; package Test::WithSetup; use App::Cmd::Setup -app => { plugins => [ qw(=Test::XyzzyPlugin) ], }; 1; release000755000766000024 012250623320 14156 5ustar00rjbsstaff000000000000App-Cmd-0.323/xtpod-syntax.t100644000766000024 21212250623320 16564 0ustar00rjbsstaff000000000000App-Cmd-0.323/xt/release#!perl 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(); Tutorial.pod100644000766000024 2277012250623320 16573 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmd # ABSTRACT: getting started with App::Cmd # PODNAME: App::Cmd::Tutorial __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Tutorial - getting started with App::Cmd =head1 VERSION version 0.323 =head1 DESCRIPTION App::Cmd is a set of tools designed to make it simple to write sophisticated command line programs. It handles commands with multiple subcommands, generates usage text, validates options, and lets you write your program as easy-to-test classes. An App::Cmd-based application is made up of three main parts: the script, the application class, and the command classes. =head2 The Script The script is the actual executable file run at the command line. It can generally consist of just a few lines: #!/usr/bin/perl use YourApp; YourApp->run; =head2 The Application Class All the work of argument parsing, validation, and dispatch is taken care of by your application class. The application class can also be pretty simple, and might look like this: package YourApp; use App::Cmd::Setup -app; 1; When a new application instance is created, it loads all of the command classes it can find, looking for modules under the Command namespace under its own name. In the above snippet, for example, YourApp will look for any module with a name starting with C. =head2 The Command Classes We can set up a simple command class like this: # ABSTRACT: set up YourApp package YourApp::Command::initialize; use YourApp -command; 1; Now, a user can run this command, but he'll get an error: $ yourcmd initialize YourApp::Command::initialize does not implement mandatory method 'execute' Oops! This dies because we haven't told the command class what it should do when executed. This is easy, we just add some code: sub execute { my ($self, $opt, $args) = @_; print "Everything has been initialized. (Not really.)\n"; } Now it works: $ yourcmd initialize Everything has been initialized. (Not really.) =head2 Default Commands By default applications made with App::Cmd know two commands: C and C. =over =item commands lists available commands. $yourcmd commands Available commands: commands: list the application's commands help: display a command's help screen init: set up YourApp Note that by default the commands receive a description from the C<# ABSTRACT> comment in the respective command's module, or from the C<=head1 NAME> Pod section. =item help allows one to query for details on command's specifics. $yourcmd help initialize yourcmd initialize [-z] [long options...] -z --zero ignore zeros Of course, it's possible to disable or change the default commands, see L. =back =head2 Arguments and Options In this example $ yourcmd reset -zB --new-seed xyzxy foo.db bar.db C<-zB> and C<--new-seed xyzxy> are "options" and C and C are "arguments." With a properly configured command class, the above invocation results in nicely formatted data: $opt = { zero => 1, no_backup => 1, #default value new_seed => 'xyzzy', }; $args = [ qw(foo.db bar.db) ]; Arguments are processed by L (GLD). To customize its argument processing, a command class can implement a few methods: C provides the usage format string; C provides the option specification list; C is run after Getopt::Long::Descriptive, and is meant to validate the C<$args>, which GLD ignores. See L for format specifications. The first two methods provide configuration passed to GLD's C routine. To improve our command class, we might add the following code: sub usage_desc { "yourcmd %o [dbfile ...]" } sub opt_spec { return ( [ "skip-refs|R", "skip reference checks during init", ], [ "values|v=s@", "starting values", { default => [ 0, 1, 3 ] } ], ); } sub validate_args { my ($self, $opt, $args) = @_; # we need at least one argument beyond the options; die with that message # and the complete "usage" text describing switches, etc $self->usage_error("too few arguments") unless @$args; } =head2 Global Options There are several ways of making options available everywhere (globally). This recipe makes local options accessible in all commands. To add a C<--help> option to all your commands create a base class like: package MyApp::Command; use App::Cmd::Setup -command; sub opt_spec { my ( $class, $app ) = @_; return ( [ 'help' => "this usage screen" ], $class->options($app), ) } sub validate_args { my ( $self, $opt, $args ) = @_; if ( $opt->{help} ) { my ($command) = $self->command_names; $self->app->execute_command( $self->app->prepare_command("help", $command) ); exit; } $self->validate( $opt, $args ); } Where C and C are "inner" methods which your command subclasses implement to provide command-specific options and validation. Note: this is a new file, previously not mentioned in this tutorial and this tip does not recommend the use of global_opt_spec which offers an alternative way of specifying global options. =head1 TIPS =over 4 =item * Delay using large modules using L, L or C in your commands to save memory and make startup faster. Since only one of these commands will be run anyway, there's no need to preload the requirements for all of them. =item * Add a C method to your commands for more verbose output from the built-in L command. sub description { return "The initialize command prepares ..."; } =item * To let your users configure default values for options, put a sub like sub config { my $app = shift; $app->{config} ||= TheLovelyConfigModule->load_config_file(); } in your main app file, and then do something like: package YourApp; sub opt_spec { my ( $class, $app ) = @_; my ( $name ) = $class->command_names; return ( [ 'blort=s' => "That special option", { default => $app->config->{$name}{blort} || $fallback_default }, ], ); } Or better yet, put this logic in a superclass and process the return value from an "inner" method: package YourApp::Command; sub opt_spec { my ( $class, $app ) = @_; return ( [ 'help' => "this usage screen" ], $class->options($app), ) } =item * You need to activate C and C as usual if you want them. App::Cmd doesn't do that for you. =back =head1 IGNORING THINGS Some people find that for whatever reason, they wish to put Modules in their C namespace which are not commands, or not commands intended for use by C. Good examples include, but are not limited to, things like C, where C<::Quietly> is only useful for the C command. The default behaviour is to treat such packages as errors, as for the majority of use cases, things in C<::Command> are expected to I be commands, and thus, anything that, by our heuristics, is not a command, is highly likely to be a mistake. And as all commands are loaded simultaneously, an error in any one of these commands will yield a fatal error. There are a few ways to specify that you are sure you want to do this, with varying ranges of scope and complexity. =head2 Ignoring a Single Module. This is the simplest approach, and most useful for one-offs. package YourApp::Command::foo::NotACommand; use YourApp -ignore; This will register this package's namespace with YourApp to be excluded from its plugin validation magic. It otherwise makes no changes to C<::NotACommand>'s namespace, does nothing magical with C<@ISA>, and doesn't bolt any hidden functions on. Its also probably good to notice that it is ignored I by C. If for whatever reason you have two different C systems under which C<::NotACommand> is visible, you'll need to set it ignored to both. This is probably a big big warning B to do that. =head2 Ignoring Multiple modules from the App level. If you really fancy it, you can override the C method provided by C to tweak its ignore logic. The most useful example of this is as follows: sub should_ignore { my ( $self, $command_class ) = @_; return 1 if not $command_class->isa( 'App::Cmd::Command' ); return; } This will prematurely mark for ignoring all packages that don't subclass C, which causes non-commands ( or perhaps commands that are coded wrongly / broken ) to be silently skipped. Note that by overriding this method, you will lose the effect of any of the other ignore mechanisms completely. If you want to combine the original C method with your own logic, you'll want to steal C's C method modifier. use Moose::Util; Moose::Util::add_method_modifier( __PACKAGE__, 'around', [ should_ignore => sub { my $orig = shift; my $self = shift; return 1 if not $command_class->isa( 'App::Cmd::Command' ); return $self->$orig( @_ ); }]); =head1 SEE ALSO L =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut MyCmdAbbrev.pm100644000766000024 17412250623320 16646 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testpackage Test::MyCmdAbbrev; use strict; use warnings; use base qw{ App::Cmd }; sub allow_any_unambiguous_abbrev { 1 } 1; XyzzyPlugin.pm100644000766000024 31112250623320 17040 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; package Test::XyzzyPlugin; use App::Cmd::Setup -plugin => { exports => [ qw(xyzzy) ], }; sub xyzzy { my ($self, $cmd, @arg) = @_; return [ $self, $cmd, \@arg ]; } 1; Subdispatch.pm100644000766000024 445412250623320 17052 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::Subdispatch; { $App::Cmd::Subdispatch::VERSION = '0.323'; } use App::Cmd; use App::Cmd::Command; BEGIN { our @ISA = qw(App::Cmd::Command App::Cmd) } # ABSTRACT: an App::Cmd::Command that is also an App::Cmd sub new { my ($inv, $fields, @args) = @_; if (ref $inv) { @{ $inv }{ keys %$fields } = values %$fields; return $inv; } else { $inv->SUPER::new($fields, @args); } } sub prepare { my ($class, $app, @args) = @_; my $self = $class->new({ app => $app }); my ($subcommand, $opt, @sub_args) = $self->get_command(@args); $self->set_global_options($opt); if (defined $subcommand) { return $self->_prepare_command($subcommand, $opt, @sub_args); } else { if (@args) { return $self->_bad_command(undef, $opt, @sub_args); } else { return $self->prepare_default_command($opt, @sub_args); } } } sub _plugin_prepare { my ($self, $plugin, @args) = @_; return $plugin->prepare($self->choose_parent_app($self->app, $plugin), @args); } sub app { $_[0]{app} } sub choose_parent_app { my ( $self, $app, $plugin ) = @_; if ( $plugin->isa("App::Cmd::Command::commands") or $plugin->isa("App::Cmd::Command::help") or scalar keys %{ $self->global_options } ) { return $self; } else { return $app; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Subdispatch - an App::Cmd::Command that is also an App::Cmd =head1 VERSION version 0.323 =head1 METHODS =head2 new A hackish new that allows us to have an Command instance before they normally exist. =head2 prepare my $subcmd = $subdispatch->prepare($app, @args); An overridden version of L that performs a new dispatch cycle. =head2 app $subdispatch->app; This method returns the application that this subdispatch is a command of. =head2 choose_parent_app $subcmd->prepare( $subdispatch->choose_parent_app($app, $opt, $plugin), @$args ); A method that chooses whether the parent app or the subdispatch is going to be C<< $cmd->app >>. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut WithCallback.pm100644000766000024 12512250623320 17037 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; package Test::WithCallback; use App::Cmd::Setup -app; 1; ArgProcessor.pm100644000766000024 165412250623320 17211 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmduse strict; use warnings; package App::Cmd::ArgProcessor; { $App::Cmd::ArgProcessor::VERSION = '0.323'; } # ABSTRACT: App::Cmd-specific wrapper for Getopt::Long::Descriptive sub _process_args { my ($class, $args, @params) = @_; local @ARGV = @$args; require Getopt::Long::Descriptive; Getopt::Long::Descriptive->VERSION(0.084); my ($opt, $usage) = Getopt::Long::Descriptive::describe_options(@params); return ( $opt, [ @ARGV ], # whatever remained usage => $usage, ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::ArgProcessor - App::Cmd-specific wrapper for Getopt::Long::Descriptive =head1 VERSION version 0.323 =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Command000755000766000024 012250623320 15452 5ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmdhelp.pm100644000766000024 705112250623320 17103 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmd/Commanduse strict; use warnings; package App::Cmd::Command::help; { $App::Cmd::Command::help::VERSION = '0.323'; } use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command'; } # ABSTRACT: display a command's help screen sub command_names { qw/help --help -h -?/ } sub description { "This command will either list all of the application commands and their abstracts, or display the usage screen for a subcommand with its description.\n" } sub execute { my ($self, $opts, $args) = @_; if (!@$args) { my $usage = $self->app->usage->text; my $command = $0; # chars normally used to describe options my $opt_descriptor_chars = qr/[\[\]<>\(\)]/; if ($usage =~ /^(.+?) \s* (?: $opt_descriptor_chars | $ )/x) { # try to match subdispatchers too $command = $1; } # evil hack ;-) bless $self->app->{usage} = sub { return "$command help \n" } => "Getopt::Long::Descriptive::Usage"; $self->app->execute_command( $self->app->_prepare_command("commands") ); } else { my ($cmd, $opt, $args) = $self->app->prepare_command(@$args); local $@; my $desc = $cmd->description; $desc = "\n$desc" if length $desc; my $ut = join "\n", eval { $cmd->usage->leader_text }, $desc, eval { $cmd->usage->option_text }; print "$ut\n"; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Command::help - display a command's help screen =head1 VERSION version 0.323 =head1 DESCRIPTION This command plugin implements a "help" command. This command will either list all of an App::Cmd's commands and their abstracts, or display the usage screen for a subcommand with its description. =head1 USAGE The help text is generated from three sources: =over 4 =item * The C method =item * The C method =item * The C data structure =back The C method provides the opening usage line, following the specification described in L. In some cases, the default C in L may be sufficient and you will only need to override it to provide additional command line usage information. The C data structure is used with L to generate the description of the options. Subcommand classes should override the C method to provide additional information that is prepended before the option descriptions. For example, consider the following subcommand module: package YourApp::Command::initialize; # This is the default from App::Cmd::Command sub usage_desc { my ($self) = @_; my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o" return "$desc [DIRECTORY]"; } sub description { return "The initialize command prepares the application..."; } sub opt_spec { return ( [ "skip-refs|R", "skip reference checks during init", ], [ "values|v=s@", "starting values", { default => [ 0, 1, 3 ] } ], ); } ... That module would generate help output like this: $ yourapp help initialize yourapp initialize [-Rv] [long options...] [DIRECTORY] The initialize command prepares the application... --help This usage screen -R --skip-refs skip reference checks during init -v --values starting values =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut IgnoreCommand.pm100644000766000024 12612250623320 17232 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Testuse strict; use warnings; package Test::IgnoreCommand; use App::Cmd::Setup -app; 1; 000-report-versions-tiny.t100644000766000024 607712250623320 17344 0ustar00rjbsstaff000000000000App-Cmd-0.323/tuse strict; use warnings; use Test::More 0.88; # This is a relatively nice way to avoid Test::NoWarnings breaking our # expectations by adding extra tests, without using no_plan. It also helps # avoid any other test module that feels introducing random tests, or even # test plans, is a nice idea. our $success = 0; END { $success && done_testing; } # List our own version used to generate this my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.10\n"; eval { # no excuses! # report our Perl details my $want = '5.006'; $v .= "perl: $] (wanted $want) on $^O from $^X\n\n"; }; defined($@) and diag("$@"); # Now, our module version dependencies: sub pmver { my ($module, $wanted) = @_; $wanted = " (want $wanted)"; my $pmver; eval "require $module;"; if ($@) { if ($@ =~ m/Can't locate .* in \@INC/) { $pmver = 'module not found.'; } else { diag("${module}: $@"); $pmver = 'died during require.'; } } else { my $version; eval { $version = $module->VERSION; }; if ($@) { diag("${module}: $@"); $pmver = 'died during VERSION check.'; } elsif (defined $version) { $pmver = "$version"; } else { $pmver = ''; } } # So, we should be good, right? return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n"); } eval { $v .= pmver('Capture::Tiny','0.13') }; eval { $v .= pmver('Carp','any version') }; eval { $v .= pmver('Class::Load','0.06') }; eval { $v .= pmver('Data::Dumper','any version') }; eval { $v .= pmver('Data::OptList','any version') }; eval { $v .= pmver('ExtUtils::MakeMaker','6.30') }; eval { $v .= pmver('File::Basename','any version') }; eval { $v .= pmver('Getopt::Long','2.39') }; eval { $v .= pmver('Getopt::Long::Descriptive','0.084') }; eval { $v .= pmver('IO::TieCombine','any version') }; eval { $v .= pmver('IPC::Cmd','any version') }; eval { $v .= pmver('Module::Pluggable::Object','any version') }; eval { $v .= pmver('String::RewritePrefix','any version') }; eval { $v .= pmver('Sub::Exporter','any version') }; eval { $v .= pmver('Sub::Exporter::Util','any version') }; eval { $v .= pmver('Sub::Install','any version') }; eval { $v .= pmver('Test::Fatal','any version') }; eval { $v .= pmver('Test::More','0.96') }; eval { $v .= pmver('Text::Abbrev','any version') }; eval { $v .= pmver('base','any version') }; eval { $v .= pmver('constant','any version') }; eval { $v .= pmver('lib','any version') }; eval { $v .= pmver('parent','any version') }; eval { $v .= pmver('strict','any version') }; eval { $v .= pmver('warnings','any version') }; # All done. $v .= <<'EOT'; Thanks for using my code. I hope it works for you. If not, please try and include this output in the bug report. That will help me reproduce the issue and solve your problem. EOT diag($v); ok(1, "we really didn't test anything, just reporting data"); $success = 1; # Work around another nasty module on CPAN. :/ no warnings 'once'; $Template::Test::NO_FLUSH = 1; exit 0; version.pm100644000766000024 225412250623320 17640 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmd/Commanduse strict; use warnings; package App::Cmd::Command::version; { $App::Cmd::Command::version::VERSION = '0.323'; } use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command'; } # ABSTRACT: display an app's version sub command_names { qw/version --version/ } sub version_for_display { $_[0]->version_package->VERSION } sub version_package { ref($_[0]->app) } sub execute { my ($self, $opts, $args) = @_; printf "%s (%s) version %s (%s)\n", $self->app->arg0, $self->version_package, $self->version_for_display, $self->app->full_arg0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Command::version - display an app's version =head1 VERSION version 0.323 =head1 DESCRIPTION This plugin implements the C command, often invoked by its switch-like name, C<--version>. On execution it shows the program name, its base class with version number, and the full program name. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut commands.pm100644000766000024 501612250623320 17753 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmd/Commanduse strict; use warnings; package App::Cmd::Command::commands; { $App::Cmd::Command::commands::VERSION = '0.323'; } use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command' }; # ABSTRACT: list the application's commands sub execute { my ($self, $opt, $args) = @_; my $target = $opt->stderr ? *STDERR : *STDOUT; local $@; eval { print { $target } $self->app->_usage_text . "\n" }; print { $target } "Available commands:\n\n"; my @primary_commands = grep { $_ ne 'version' } map { ($_->command_names)[0] } $self->app->command_plugins; my @cmd_groups = $self->sort_commands(@primary_commands); my $fmt_width = 0; for (@primary_commands) { $fmt_width = length if length > $fmt_width } $fmt_width += 2; # pretty foreach my $cmd_set (@cmd_groups) { for my $command (@$cmd_set) { my $abstract = $self->app->plugin_for($command)->abstract; printf { $target } "%${fmt_width}s: %s\n", $command, $abstract; } print { $target } "\n"; } } sub sort_commands { my ($self, @commands) = @_; my $float = qr/^(?:help|commands)$/; my @head = sort grep { $_ =~ $float } @commands; my @tail = sort grep { $_ !~ $float } @commands; return (\@head, \@tail); } sub opt_spec { return ( [ 'stderr' => 'hidden' ], ); } sub description { "This command will list all of commands available and their abstracts.\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Command::commands - list the application's commands =head1 VERSION version 0.323 =head1 DESCRIPTION This command plugin implements a "commands" command. This command will list all of an App::Cmd's commands and their abstracts. =head1 METHODS =head2 execute This is the command's primary method and raison d'etre. It prints the application's usage text (if any) followed by a sorted listing of the application's commands and their abstracts. The commands are printed in sorted groups (created by C); each group is set off by blank lines. =head2 C my @sorted = $cmd->sort_commands(@unsorted); This method orders the list of commands into sets which it returns as a list of arrayrefs. By default, the first group is for the "help" and "commands" commands, and all other commands are in the second group. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut BrokenCmd000755000766000024 012250623320 15677 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/TestCommand.pm100644000766000024 15712250623320 17736 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/BrokenCmduse strict; use warnings; package Test::BrokenCmd::Command; use App::Cmd::Setup -command; die "BROKEN"; 1; WithSetup000755000766000024 012250623320 15767 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/TestCommand.pm100644000766000024 13512250623320 20022 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WithSetupuse strict; use warnings; package Test::WithSetup::Command; use App::Cmd::Setup -command; 1; Command000755000766000024 012250623320 16422 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmdexit.pm100644000766000024 47212250623320 20054 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::exit; use strict; use warnings; use base qw(App::Cmd::Command); =head1 NAME Test::MyCmd::Command::exit - exit with a given value =cut # This package exists to exiting with exit(); sub execute { my ($self, $opt, $args) = @_; exit(defined $args->[0] ? $args->[0] : 0); } 1; Command000755000766000024 012250623320 16504 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd2foo.pm100644000766000024 27512250623320 17751 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd2/Commandpackage Test::MyCmd2::Command::foo; use base qw/App::Cmd::Subdispatch/; use constant plugin_search_path => __PACKAGE__; use constant global_opt_spec => ( [ 'moose' => "lefoo" ], ); 1; changes_has_content.t100644000766000024 201112250623320 20472 0ustar00rjbsstaff000000000000App-Cmd-0.323/xt/release#!perl use Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '0.323'; my $trial_token = '-TRIAL'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; # _get_changes copied and adapted from Dist::Zilla::Plugin::Git::Commit # by Jerome Quelin sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; } hello.pm100644000766000024 63212250623320 20204 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::hello; use strict; use warnings; use base qw(App::Cmd::Command); use IPC::Cmd qw/can_run/; sub execute { my ($self, $opt, $arg) =@_; if ( $^O eq 'MSWin32' ) { system('cmd', '/c', 'echo', "Hello World"); } else { my $echo = can_run("echo"); $self->usage_error("Program 'echo' not found") unless $echo; system($echo, "Hello World"); } return; } 1; stock.pm100644000766000024 37312250623320 20226 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::stock; use strict; use warnings; use base qw(App::Cmd::Command); =head1 NAME Test::MyCmd::Command::stock - nothing here is overridden =cut # This package exists to test all the default command plugin behaviors. 1; Command000755000766000024 012250623320 16266 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WSNCCblort.pm100644000766000024 23512250623320 20066 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WSNCC/Commanduse strict; use warnings; package Test::WSNCC::Command::blort; use Test::WSNCC -command; sub execute { my ($self, $opt, $args) = @_; return $opt; } 1; IgnoreCommand000755000766000024 012250623320 16555 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/TestCommand.pm100644000766000024 20412250623320 20605 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/IgnoreCommanduse strict; use warnings; package Test::IgnoreCommand::Command; use Test::IgnoreCommand -ignore; sub foo { return "hi"; } 1; foo000755000766000024 012250623320 17267 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd2/Commandbar.pm100644000766000024 20312250623320 20504 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd2/Command/foopackage Test::MyCmd2::Command::foo::bar; use base qw/App::Cmd::Command/; use constant opt_spec => ( [ foo => "lefoo" ], ); 1; Tester000755000766000024 012250623320 15342 5ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/CmdCaptureExternal.pm100644000766000024 440412250623320 21150 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmd/Testeruse strict; use warnings; package App::Cmd::Tester::CaptureExternal; { $App::Cmd::Tester::CaptureExternal::VERSION = '0.323'; } use parent 'App::Cmd::Tester'; use Capture::Tiny 0.13 qw/capture/; # ABSTRACT: Extends App::Cmd::Tester to capture from external subprograms sub _run_with_capture { my ($class, $app, $argv) = @_; my $run_rv; my ($stdout, $stderr, $ok) = capture { eval { local $App::Cmd::Tester::TEST_IN_PROGRESS = 1; local @ARGV = @$argv; $run_rv = $app->run; 1; }; }; my $error = $ok ? undef : $@; return { stdout => $stdout, stderr => $stderr, output => $stdout . $stderr, error => $error, run_rv => $run_rv, }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Tester::CaptureExternal - Extends App::Cmd::Tester to capture from external subprograms =head1 VERSION version 0.323 =head1 SYNOPSIS use Test::More tests => 4; use App::Cmd::Tester::CaptureExternal; use YourApp; my $result = test_app(YourApp => [ qw(command --opt value) ]); like($result->stdout, qr/expected output/, 'printed what we expected'); is($result->stderr, '', 'nothing sent to sderr'); ok($result->output, "STDOUT concatenated with STDERR"); =head1 DESCRIPTION L provides a useful scaffold for testing applications, but it is unable to capture output generated from any external subprograms that are invoked from the application. This subclass uses an alternate mechanism for capturing output (L) that does capture from external programs, with one major limitation. It is not possible to capture externally from both STDOUT and STDERR while also having appropriately interleaved combined output. Therefore, the C from this subclass simply concatenates the two. You can still use C for testing if there is any output at all or for testing if something appeared in either output stream, but you can't rely on the ordering being correct between lines to STDOUT and lines to STDERR. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut frobulate.pm100644000766000024 60612250623320 21065 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::frobulate; use strict; use warnings; use base qw(App::Cmd::Command); sub command_names { return qw(frobulate frob); } sub opt_spec { return ( [ "foo-bar|F", "enable foo-bar subsystem" ], [ "widget=s", "set widget name" ], ); } sub execute { my ($self, $opt, $arg) =@_; die "the widget name is $opt->{widget} - @$arg\n"; } 1; justusage.pm100644000766000024 42512250623320 21113 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::justusage; use strict; use warnings; use base qw(App::Cmd::Command); =head1 NAME Test::MyCmd::Command::justusage - it just dies its own usage, no matter what =cut sub execute { my ($self, $opt, $arg) = @_; die $self->usage->text; } 1; Command000755000766000024 012250623320 17544 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmdAbbrevbar.pm100644000766000024 15312250623320 20765 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmdAbbrev/Commandpackage Test::MyCmdAbbrev::Command::bar; use strict; use warnings; use base qw{ App::Cmd::Command }; 1; baz.pm100644000766000024 15312250623320 20775 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmdAbbrev/Commandpackage Test::MyCmdAbbrev::Command::baz; use strict; use warnings; use base qw{ App::Cmd::Command }; 1; foo.pm100644000766000024 15312250623320 21004 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/MyCmdAbbrev/Commandpackage Test::MyCmdAbbrev::Command::foo; use strict; use warnings; use base qw{ App::Cmd::Command }; 1; Command000755000766000024 012250623320 17345 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WithSetupalfie.pm100644000766000024 24512250623320 21104 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WithSetup/Commanduse strict; use warnings; package Test::WithSetup::Command::alfie; use Test::WithSetup -command; sub execute { my ($self, $opt, $args) = @_; return $opt; } 1; Subdispatch000755000766000024 012250623320 16345 5ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/CmdDashedStyle.pm100644000766000024 364412250623320 21263 0ustar00rjbsstaff000000000000App-Cmd-0.323/lib/App/Cmd/Subdispatchuse strict; use warnings; package App::Cmd::Subdispatch::DashedStyle; { $App::Cmd::Subdispatch::DashedStyle::VERSION = '0.323'; } use App::Cmd::Subdispatch; BEGIN { our @ISA = 'App::Cmd::Subdispatch' }; # ABSTRACT: "app cmd --subcmd" style subdispatching sub get_command { my ($self, @args) = @_; my (undef, $opt, @sub_args) = $self->App::Cmd::Command::prepare($self->app, @args); if (my $cmd = delete $opt->{subcommand}) { delete $opt->{$cmd}; # useless boolean return ($cmd, $opt, @sub_args); } else { return (undef, $opt, @sub_args); } } sub prepare_default_command { my ( $self, $opt, @args ) = @_; $self->_prepare_command( "help" ); } sub opt_spec { my ($self, $app) = @_; my $subcommands = $self->_command; my %plugins = map { $_ => [ $_->command_names ], } values %$subcommands; foreach my $opt_spec (values %plugins) { $opt_spec = join("|", grep { /^\w/ } @$opt_spec); } my @subcommands = map { [ $plugins{$_} => $_->abstract ] } keys %plugins; return ( [ subcommand => hidden => { one_of => \@subcommands } ], $self->global_opt_spec($app), { getopt_conf => [ 'pass_through' ] }, ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Subdispatch::DashedStyle - "app cmd --subcmd" style subdispatching =head1 VERSION version 0.323 =head1 METHODS =head2 get_command my ($subcommand, $opt, $args) = $subdispatch->get_command(@args) A version of get_command that chooses commands as options in the following style: mytool mycommand --mysubcommand =head2 opt_spec A version of C that calculates the getopt specification from the subcommands. =for Pod::Coverage prepare_default_command =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Command000755000766000024 012250623320 17741 5ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WithCallbacklol.pm100644000766000024 47512250623320 21213 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WithCallback/Commandpackage Test::WithCallback::Command::lol; use strict; use Test::WithCallback -command; sub opt_spec { return ( [ "even|e=s", "an even number", { callbacks => { valid_email => sub { return !($_[0] % 2) } } }], ); } sub execute { print 'yay'; } 1; bertie.pm100644000766000024 26412250623320 21277 0ustar00rjbsstaff000000000000App-Cmd-0.323/t/lib/Test/WithSetup/Commanduse strict; use warnings; package Test::WithSetup::Command::bertie; use Test::WithSetup -command; sub execute { my ($self, $opt, $args) = @_; return xyzzy foo => 'bar'; } 1;