App-Cmd-0.334000755000765000024 014063251373 12174 5ustar00rjbsstaff000000000000README100644000765000024 56614063251373 13124 0ustar00rjbsstaff000000000000App-Cmd-0.334This archive contains the distribution App-Cmd, version 0.334: write command line apps with less suffering This software is copyright (c) 2021 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. This README file was generated by Dist::Zilla::Plugin::Readme v6.021. Changes100644000765000024 2171614063251373 13577 0ustar00rjbsstaff000000000000App-Cmd-0.334Revision history for App-Cmd 0.334 2021-06-18 22:14:14-04:00 America/New_York - add a perl-support block to docs - update author contact info 0.333 2021-03-14 15:45:02-04:00 America/New_York - dial back required perl to v5.20.0 0.332 2021-03-12 21:25:38-05:00 America/New_York - bump up minimum required perl to the one from 5yr ago - make some tests laxer to prep for changes in Getopt::Long::Descriptive - the App::Cmd object is constructed and blessed in new before _command is called on it (thanks, Lucas Theisen) 0.331 2016-07-17 15:56:11-04:00 America/New_York - documentation improvements (thanks, Davor Cubranic!) 0.330 2015-10-23 23:21:35-04:00 America/New_York - do not add "--help" to global opt spec twice (oops!) 0.329 2015-10-07 13:01:34-04:00 America/New_York - bump required version of Pod::Usage 0.328 2015-09-03 20:37:50-04:00 America/New_York - get command description from Pod by default (Jakob Voss) - add a "--help" option to all commands by default (Jakob Voss) - add "command_groups" to group commands in listing (Jakob Voss) - fix the handling of "exit" in App::Cmd::Tester (Matthew Astley) - add 'show_version_cmd' option to enable display of 'version' command in command list. (John Anderson) - minor documentation improvements (Alberto Simões, rjbs) 0.327 2015-02-23 20:05:00-05:00 America/New_York - fix behavior of default command under subdispatch (thanks, Stephen Caldwell and Diab Jerius!) - simplify help and commands commands (thanks, Sergey Romanov) - drop some advice that we didn't feel great about (thanks, Karen Etheridge) 0.326 2014-11-30 08:48:29-05:00 America/New_York fix the path fix because it was broken by a related fix in EUMM 0.325 2014-11-29 20:48:34-05:00 America/New_York fix a path-related test failure on Win32 (thanks, A. Sinan Unur!) 0.324 2014-10-20 18:22:25-04:00 America/New_York note that `cmd help` can take a subcommand in `cmd help help` 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) LICENSE100644000765000024 4366314063251373 13316 0ustar00rjbsstaff000000000000App-Cmd-0.334This software is copyright (c) 2021 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) 2021 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, Fifth Floor, Boston, MA 02110-1301 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) 2021 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.ini100644000765000024 40314063251373 13676 0ustar00rjbsstaff000000000000App-Cmd-0.334name = App-Cmd author = Ricardo Signes license = Perl_5 copyright_holder = Ricardo Signes [@RJBS] perl-support = long-term [Prereqs] Getopt::Long = 2.39 ; avoid --version mixup Getopt::Long::Descriptive = 0.084 Pod::Usage = 1.61 META.yml100644000765000024 3243514063251373 13555 0ustar00rjbsstaff000000000000App-Cmd-0.334--- abstract: 'write command line apps with less suffering' author: - 'Ricardo Signes ' build_requires: Data::Dumper: '0' ExtUtils::MakeMaker: '0' File::Spec: '0' IPC::Cmd: '0' Test::Fatal: '0' Test::More: '0.96' lib: '0' configure_requires: ExtUtils::MakeMaker: '6.78' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.021, CPAN::Meta::Converter version 2.150010' 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' Pod::Usage: '1.61' String::RewritePrefix: '0' Sub::Exporter: '0' Sub::Exporter::Util: '0' Sub::Install: '0' Text::Abbrev: '0' constant: '0' experimental: '0' parent: '0' perl: '5.020' 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.334' x_Dist_Zilla: perl: version: '5.034000' plugins: - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: [] exclude_match: [] follow_symlinks: 0 include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: '@RJBS/Git::GatherDir' version: '2.047' - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: '@RJBS/CheckPrereqsIndexed' version: '0.020' - class: Dist::Zilla::Plugin::CheckExtraTests name: '@RJBS/CheckExtraTests' version: '0.029' - 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 run_under_travis: 0 skip: [] name: '@RJBS/RJBS-Outdated' version: '0.057' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 1 check_all_prereqs: 0 modules: [] phase: release run_under_travis: 0 skip: - Dist::Zilla::Plugin::RJBSMisc name: '@RJBS/CPAN-Outdated' version: '0.057' - class: Dist::Zilla::Plugin::PruneCruft name: '@RJBS/@Filter/PruneCruft' version: '6.021' - class: Dist::Zilla::Plugin::ManifestSkip name: '@RJBS/@Filter/ManifestSkip' version: '6.021' - class: Dist::Zilla::Plugin::MetaYAML name: '@RJBS/@Filter/MetaYAML' version: '6.021' - class: Dist::Zilla::Plugin::License name: '@RJBS/@Filter/License' version: '6.021' - class: Dist::Zilla::Plugin::Readme name: '@RJBS/@Filter/Readme' version: '6.021' - class: Dist::Zilla::Plugin::ExecDir name: '@RJBS/@Filter/ExecDir' version: '6.021' - class: Dist::Zilla::Plugin::ShareDir name: '@RJBS/@Filter/ShareDir' version: '6.021' - class: Dist::Zilla::Plugin::Manifest name: '@RJBS/@Filter/Manifest' version: '6.021' - class: Dist::Zilla::Plugin::TestRelease name: '@RJBS/@Filter/TestRelease' version: '6.021' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@RJBS/@Filter/ConfirmRelease' version: '6.021' - class: Dist::Zilla::Plugin::UploadToCPAN name: '@RJBS/@Filter/UploadToCPAN' version: '6.021' - class: Dist::Zilla::Plugin::MakeMaker config: Dist::Zilla::Role::TestRunner: default_jobs: 9 name: '@RJBS/MakeMaker' version: '6.021' - class: Dist::Zilla::Plugin::AutoPrereqs name: '@RJBS/AutoPrereqs' version: '6.021' - class: Dist::Zilla::Plugin::Git::NextVersion config: Dist::Zilla::Plugin::Git::NextVersion: first_version: '0.001' version_by_branch: 1 version_regexp: (?^:^([0-9]+\.[0-9]+)$) Dist::Zilla::Role::Git::Repo: git_version: '2.30.1 (Apple Git-130)' repo_root: . name: '@RJBS/Git::NextVersion' version: '2.047' - class: Dist::Zilla::Plugin::PkgVersion name: '@RJBS/PkgVersion' version: '6.021' - class: Dist::Zilla::Plugin::MetaConfig name: '@RJBS/MetaConfig' version: '6.021' - class: Dist::Zilla::Plugin::MetaJSON name: '@RJBS/MetaJSON' version: '6.021' - class: Dist::Zilla::Plugin::NextRelease name: '@RJBS/NextRelease' version: '6.021' - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: '@RJBS/Test::ChangesHasContent' version: '0.011' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@RJBS/PodSyntaxTests' version: '6.021' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: '@RJBS/Test::ReportPrereqs' version: '0.028' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@RJBS/TestMoreWithSubtests' version: '6.021' - class: Dist::Zilla::Plugin::PodWeaver config: Dist::Zilla::Plugin::PodWeaver: config_plugins: - '@RJBS' finder: - ':InstallModules' - ':ExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: '4.017' - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: '4.017' - class: Pod::Weaver::Plugin::SingleEncoding name: '@RJBS/SingleEncoding' version: '4.017' - class: Pod::Weaver::Section::Name name: '@RJBS/Name' version: '4.017' - class: Pod::Weaver::Section::Version name: '@RJBS/Version' version: '4.017' - class: Pod::Weaver::Section::Region name: '@RJBS/Prelude' version: '4.017' - class: Pod::Weaver::Section::Generic name: '@RJBS/Synopsis' version: '4.017' - class: Pod::Weaver::Section::Generic name: '@RJBS/Description' version: '4.017' - class: Pod::Weaver::Section::Generic name: '@RJBS/Overview' version: '4.017' - class: Pod::Weaver::Section::Generic name: '@RJBS/Stability' version: '4.017' - class: Pod::Weaver::Section::GenerateSection name: '@RJBS/PerlSupport' version: '4.017' - class: Pod::Weaver::Section::Collect name: Attributes version: '4.017' - class: Pod::Weaver::Section::Collect name: Methods version: '4.017' - class: Pod::Weaver::Section::Collect name: Functions version: '4.017' - class: Pod::Weaver::Section::Leftovers name: '@RJBS/Leftovers' version: '4.017' - class: Pod::Weaver::Section::Region name: '@RJBS/postlude' version: '4.017' - class: Pod::Weaver::Section::Authors name: '@RJBS/Authors' version: '4.017' - class: Pod::Weaver::Section::Contributors name: '@RJBS/Contributors' version: '0.009' - class: Pod::Weaver::Section::Legal name: '@RJBS/Legal' version: '4.017' - class: Pod::Weaver::Plugin::Transformer name: '@RJBS/List' version: '4.017' name: '@RJBS/PodWeaver' version: '4.008' - class: Dist::Zilla::Plugin::RJBSMisc name: '@RJBS/RJBSMisc' version: '5.018' - class: Dist::Zilla::Plugin::GithubMeta name: '@RJBS/GithubMeta' version: '0.58' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: '2.30.1 (Apple Git-130)' repo_root: . name: '@RJBS/@Git/Check' version: '2.047' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: v%V%n%n%c signoff: '0' Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: '2.30.1 (Apple Git-130)' repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@RJBS/@Git/Commit' version: '2.047' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: '0.334' tag_format: '%v' tag_message: v%V Dist::Zilla::Role::Git::Repo: git_version: '2.30.1 (Apple Git-130)' repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@RJBS/@Git/Tag' version: '2.047' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - 'github :' remotes_must_exist: 0 Dist::Zilla::Role::Git::Repo: git_version: '2.30.1 (Apple Git-130)' repo_root: . name: '@RJBS/@Git/Push' version: '2.047' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: '2.30.1 (Apple Git-130)' include_authors: 0 include_releaser: 1 order_by: name paths: [] name: '@RJBS/Git::Contributors' version: '0.036' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.021' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.021' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' version: '6.021' x_contributors: - 'Adam Prime ' - 'ambs ' - 'Andreas Hernitscheck ' - 'A. Sinan Unur ' - "Chris 'BinGOs' Williams " - 'David Golden ' - 'David Steinbrunner ' - 'Davor Cubranic ' - 'Denis Ibaev ' - 'Diab Jerius ' - 'Glenn Fowler ' - 'Ingy dot Net ' - 'Jakob Voss ' - 'Jakob Voss ' - 'Jérôme Quelin ' - 'John SJ Anderson ' - 'Karen Etheridge ' - 'Kent Fredric ' - 'Lucas Theisen ' - 'Matthew Astley ' - 'mokko ' - 'Olivier Mengué ' - 'Ryan C. Thompson ' - 'Salvatore Bonaccorso ' - 'Sergey Romanov ' - 'Stephan Loyd ' - 'Stephen Caldwell ' - 'Yuval Kogman ' x_generated_by_perl: v5.34.0 x_rjbs_perl_support: long-term x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644000765000024 336614063251373 13416 0ustar00rjbsstaff000000000000App-Cmd-0.334# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.021. Changes 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/00-report-prereqs.dd t/00-report-prereqs.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 t/tester-exit.helper.pl t/tester-exit.t t/version.t xt/author/pod-syntax.t xt/release/changes_has_content.t t000755000765000024 014063251373 12360 5ustar00rjbsstaff000000000000App-Cmd-0.334basic.t100644000765000024 431714063251373 13773 0ustar00rjbsstaff000000000000App-Cmd-0.334/t#!perl use strict; use warnings; use Test::More tests => 17; 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) ]); like( $return->stdout, qr{\Abasic\.t \(Test::MyCmd\) version 0\.123 \(t[\\/]basic\.t\)\Z}, "version plugin enabled" ); is( test_app('Test::MyCmd', [ qw(commands --help) ])->stdout, test_app('Test::MyCmd', [ qw(help commands) ])->stdout, "map --help to help command" ); $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"); } { my $return = test_app('Test::MyCmd', [ qw(help exit) ]); is $return->stdout, <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.json100644000765000024 5047514063251373 13731 0ustar00rjbsstaff000000000000App-Cmd-0.334{ "abstract" : "write command line apps with less suffering", "author" : [ "Ricardo Signes " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.021, CPAN::Meta::Converter version 2.150010", "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.78" } }, "develop" : { "requires" : { "Encode" : "0", "Test::More" : "0", "Test::Pod" : "1.41" } }, "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", "Pod::Usage" : "1.61", "String::RewritePrefix" : "0", "Sub::Exporter" : "0", "Sub::Exporter::Util" : "0", "Sub::Install" : "0", "Text::Abbrev" : "0", "constant" : "0", "experimental" : "0", "parent" : "0", "perl" : "5.020", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "Data::Dumper" : "0", "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "IPC::Cmd" : "0", "Test::Fatal" : "0", "Test::More" : "0.96", "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.334", "x_Dist_Zilla" : { "perl" : { "version" : "5.034000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [], "exclude_match" : [], "follow_symlinks" : 0, "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "@RJBS/Git::GatherDir", "version" : "2.047" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "@RJBS/CheckPrereqsIndexed", "version" : "0.020" }, { "class" : "Dist::Zilla::Plugin::CheckExtraTests", "name" : "@RJBS/CheckExtraTests", "version" : "0.029" }, { "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", "run_under_travis" : 0, "skip" : [] } }, "name" : "@RJBS/RJBS-Outdated", "version" : "0.057" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 1, "check_all_prereqs" : 0, "modules" : [], "phase" : "release", "run_under_travis" : 0, "skip" : [ "Dist::Zilla::Plugin::RJBSMisc" ] } }, "name" : "@RJBS/CPAN-Outdated", "version" : "0.057" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@RJBS/@Filter/PruneCruft", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@RJBS/@Filter/ManifestSkip", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@RJBS/@Filter/MetaYAML", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@RJBS/@Filter/License", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "@RJBS/@Filter/Readme", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@RJBS/@Filter/ExecDir", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@RJBS/@Filter/ShareDir", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@RJBS/@Filter/Manifest", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@RJBS/@Filter/TestRelease", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@RJBS/@Filter/ConfirmRelease", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@RJBS/@Filter/UploadToCPAN", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 9 } }, "name" : "@RJBS/MakeMaker", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@RJBS/AutoPrereqs", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "config" : { "Dist::Zilla::Plugin::Git::NextVersion" : { "first_version" : "0.001", "version_by_branch" : 1, "version_regexp" : "(?^:^([0-9]+\\.[0-9]+)$)" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.30.1 (Apple Git-130)", "repo_root" : "." } }, "name" : "@RJBS/Git::NextVersion", "version" : "2.047" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "@RJBS/PkgVersion", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@RJBS/MetaConfig", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@RJBS/MetaJSON", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@RJBS/NextRelease", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "@RJBS/Test::ChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@RJBS/PodSyntaxTests", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "@RJBS/Test::ReportPrereqs", "version" : "0.028" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@RJBS/TestMoreWithSubtests", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "config" : { "Dist::Zilla::Plugin::PodWeaver" : { "config_plugins" : [ "@RJBS" ], "finder" : [ ":InstallModules", ":ExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.017" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.017" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@RJBS/SingleEncoding", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@RJBS/Name", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@RJBS/Version", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@RJBS/Prelude", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Synopsis", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Description", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Overview", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Stability", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@RJBS/PerlSupport", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Attributes", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Methods", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Functions", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@RJBS/Leftovers", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@RJBS/postlude", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@RJBS/Authors", "version" : "4.017" }, { "class" : "Pod::Weaver::Section::Contributors", "name" : "@RJBS/Contributors", "version" : "0.009" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@RJBS/Legal", "version" : "4.017" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@RJBS/List", "version" : "4.017" } ] } }, "name" : "@RJBS/PodWeaver", "version" : "4.008" }, { "class" : "Dist::Zilla::Plugin::RJBSMisc", "name" : "@RJBS/RJBSMisc", "version" : "5.018" }, { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "@RJBS/GithubMeta", "version" : "0.58" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.30.1 (Apple Git-130)", "repo_root" : "." } }, "name" : "@RJBS/@Git/Check", "version" : "2.047" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "v%V%n%n%c", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.30.1 (Apple Git-130)", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@RJBS/@Git/Commit", "version" : "2.047" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "0.334", "tag_format" : "%v", "tag_message" : "v%V" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.30.1 (Apple Git-130)", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@RJBS/@Git/Tag", "version" : "2.047" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "github :" ], "remotes_must_exist" : 0 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.30.1 (Apple Git-130)", "repo_root" : "." } }, "name" : "@RJBS/@Git/Push", "version" : "2.047" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.30.1 (Apple Git-130)", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "@RJBS/Git::Contributors", "version" : "0.036" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.021" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.021" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.021" } }, "x_contributors" : [ "Adam Prime ", "ambs ", "Andreas Hernitscheck ", "A. Sinan Unur ", "Chris 'BinGOs' Williams ", "David Golden ", "David Steinbrunner ", "Davor Cubranic ", "Denis Ibaev ", "Diab Jerius ", "Glenn Fowler ", "Ingy dot Net ", "Jakob Voss ", "Jakob Voss ", "J\u00e9r\u00f4me Quelin ", "John SJ Anderson ", "Karen Etheridge ", "Kent Fredric ", "Lucas Theisen ", "Matthew Astley ", "mokko ", "Olivier Mengu\u00e9 ", "Ryan C. Thompson ", "Salvatore Bonaccorso ", "Sergey Romanov ", "Stephan Loyd ", "Stephen Caldwell ", "Yuval Kogman " ], "x_generated_by_perl" : "v5.34.0", "x_rjbs_perl_support" : "long-term", "x_serialization_backend" : "Cpanel::JSON::XS version 4.26", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } abbrev.t100644000765000024 62514063251373 14131 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 43114063251373 14017 0ustar00rjbsstaff000000000000App-Cmd-0.334/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" ); version.t100755000765000024 116014063251373 14373 0ustar00rjbsstaff000000000000App-Cmd-0.334/t#!perl use strict; use warnings; use Test::More; use App::Cmd::Tester; use lib 't/lib'; use Test::MyCmd; { my $app = Test::MyCmd->new({ show_version_cmd => 1 }); my $ret = App::Cmd::Tester->_run_with_capture( $app , [ 'commands' ]); like( $ret->{output} , qr/version/ , 'see version in output'); is( $ret->{error} , undef , 'no errors' ); } { my $app = Test::MyCmd->new({ show_version_cmd => 0 }); my $ret = App::Cmd::Tester->_run_with_capture( $app , [ 'commands' ]); unlike( $ret->{output} , qr/version/ , 'do not see version in output'); is( $ret->{error} , undef , 'no errors' ); } done_testing; Makefile.PL100644000765000024 443714063251373 14237 0ustar00rjbsstaff000000000000App-Cmd-0.334# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.021. use strict; use warnings; use 5.020; use ExtUtils::MakeMaker 6.78; my %WriteMakefileArgs = ( "ABSTRACT" => "write command line apps with less suffering", "AUTHOR" => "Ricardo Signes ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.78" }, "DISTNAME" => "App-Cmd", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.020", "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, "Pod::Usage" => "1.61", "String::RewritePrefix" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sub::Install" => 0, "Text::Abbrev" => 0, "constant" => 0, "experimental" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Data::Dumper" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "IPC::Cmd" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "lib" => 0 }, "VERSION" => "0.334", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Capture::Tiny" => "0.13", "Carp" => 0, "Class::Load" => "0.06", "Data::Dumper" => 0, "Data::OptList" => 0, "ExtUtils::MakeMaker" => 0, "File::Basename" => 0, "File::Spec" => 0, "Getopt::Long" => "2.39", "Getopt::Long::Descriptive" => "0.084", "IO::TieCombine" => 0, "IPC::Cmd" => 0, "Module::Pluggable::Object" => 0, "Pod::Usage" => "1.61", "String::RewritePrefix" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sub::Install" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "Text::Abbrev" => 0, "constant" => 0, "experimental" => 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.t100644000765000024 127714063251373 14450 0ustar00rjbsstaff000000000000App-Cmd-0.334/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" ); lib000755000765000024 014063251373 13126 5ustar00rjbsstaff000000000000App-Cmd-0.334/tlol.pl100644000765000024 6114063251373 14346 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/libuse Test::WithCallback; Test::WithCallback->run App000755000765000024 014063251373 13403 5ustar00rjbsstaff000000000000App-Cmd-0.334/libCmd.pm100644000765000024 7133314063251373 14633 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App# The "experimental" below is not actually scary. The feature went on to be # de-experimental-ized with no changes and is now on by default in perl v5.24 # and later. -- rjbs, 2021-03-14 use 5.020; use warnings; use experimental qw(postderef postderef_qq); package App::Cmd 0.334; use parent '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 } #pod =head1 SYNOPSIS #pod #pod in F: #pod #pod use YourApp; #pod YourApp->run; #pod #pod in F: #pod #pod package YourApp; #pod use App::Cmd::Setup -app; #pod 1; #pod #pod in F: #pod #pod package YourApp::Command::blort; #pod use YourApp -command; #pod use strict; use warnings; #pod #pod sub abstract { "blortex algorithm" } #pod #pod sub description { "Long description on blortex algorithm" } #pod #pod sub opt_spec { #pod return ( #pod [ "blortex|X", "use the blortex algorithm" ], #pod [ "recheck|r", "recheck all results" ], #pod ); #pod } #pod #pod sub validate_args { #pod my ($self, $opt, $args) = @_; #pod #pod # no args allowed but options! #pod $self->usage_error("No args allowed") if @$args; #pod } #pod #pod sub execute { #pod my ($self, $opt, $args) = @_; #pod #pod my $result = $opt->{blortex} ? blortex() : blort(); #pod #pod recheck($result) if $opt->{recheck}; #pod #pod print $result; #pod } #pod #pod and, finally, at the command line: #pod #pod knight!rjbs$ yourcmd blort --recheck #pod #pod All blorts successful. #pod #pod =head1 DESCRIPTION #pod #pod App::Cmd is intended to make it easy to write complex command-line applications #pod without having to think about most of the annoying things usually involved. #pod #pod For information on how to start using App::Cmd, see L. #pod #pod =method new #pod #pod my $cmd = App::Cmd->new(\%arg); #pod #pod This method returns a new App::Cmd object. During initialization, command #pod plugins will be loaded. #pod #pod Valid arguments are: #pod #pod no_commands_plugin - if true, the command list plugin is not added #pod #pod no_help_plugin - if true, the help plugin is not added #pod #pod no_version_plugin - if true, the version plugin is not added #pod #pod show_version_cmd - if true, the version command will be shown in the #pod command list #pod #pod plugin_search_path - The path to search for commands in. Defaults to #pod results of plugin_search_path method #pod #pod If C is not given, L will be #pod required, and it will be registered to handle all of its command names not #pod handled by other plugins. #pod #pod If C is not given, L will be required, #pod and it will be registered to handle all of its command names not handled by #pod other plugins. B "help" is the default command, so if you do not load #pod the default help plugin, you should provide your own or override the #pod C method. #pod #pod If C is not given, L will be #pod required to show the application's version with command C<--version>. By #pod default, the version command is not included in the command list. Pass #pod C to include the version command in the list. #pod #pod =cut sub new { my ($class, $arg) = @_; my $arg0 = $0; my $base = File::Basename::basename $arg0; my $self = { arg0 => $base, full_arg0 => $arg0, show_version => $arg->{show_version_cmd} // 0, }; bless $self, $class; $self->{command} = $self->_command($arg); return $self; } # 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; } } } #pod =method run #pod #pod $cmd->run; #pod #pod This method runs the application. If called the class, it will instantiate a #pod new App::Cmd object to run. #pod #pod It determines the requested command (generally by consuming the first #pod command-line argument), finds the plugin to handle that command, parses the #pod remaining arguments according to that plugin's rules, and runs the plugin. #pod #pod It passes the contents of the global argument array (C<@ARGV>) to #pod L>, but C<@ARGV> is not altered by running an App::Cmd. #pod #pod =cut 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); } #pod =method prepare_args #pod #pod Normally App::Cmd uses C<@ARGV> for its commandline arguments. You can override #pod this method to change that behavior for testing or otherwise. #pod #pod =cut sub prepare_args { my ($self) = @_; return scalar(@ARGV) ? (@ARGV) : ($self->default_args->@*); } #pod =method default_args #pod #pod If C> is not changed and there are no arguments in C<@ARGV>, #pod this method is called and should return an arrayref to be used as the arguments #pod to the program. By default, it returns an empty arrayref. #pod #pod =cut use constant default_args => []; #pod =method abstract #pod #pod sub abstract { "command description" } #pod #pod Defines the command abstract: a short description that will be printed in the #pod main command options list. #pod #pod =method description #pod #pod sub description { "Long description" } #pod #pod Defines a longer command description that will be shown when the user asks for #pod help on a specific command. #pod #pod =method arg0 #pod #pod =method full_arg0 #pod #pod my $program_name = $app->arg0; #pod #pod my $full_program_name = $app->full_arg0; #pod #pod These methods return the name of the program invoked to run this application. #pod This is determined by inspecting C<$0> when the App::Cmd object is #pod instantiated, so it's probably correct, but doing weird things with App::Cmd #pod could lead to weird values from these methods. #pod #pod If the program was run like this: #pod #pod knight!rjbs$ ~/bin/rpg dice 3d6 #pod #pod Then the methods return: #pod #pod arg0 - rpg #pod full_arg0 - /Users/rjbs/bin/rpg #pod #pod These values are captured when the App::Cmd object is created, so it is safe to #pod assign to C<$0> later. #pod #pod =cut sub arg0 { $_[0]->{arg0} } sub full_arg0 { $_[0]->{full_arg0} } #pod =method prepare_command #pod #pod my ($cmd, $opt, @args) = $app->prepare_command(@ARGV); #pod #pod This method will load the plugin for the requested command, use its options to #pod parse the command line arguments, and eventually return everything necessary to #pod actually execute the command. #pod #pod =cut 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 }; #pod =method default_command #pod #pod This method returns the name of the command to run if none is given on the #pod command line. The default default is "help" #pod #pod =cut sub default_command { "help" } #pod =method execute_command #pod #pod $app->execute_command($cmd, \%opt, @args); #pod #pod This method will invoke C and then C on C<$cmd>. #pod #pod =cut sub execute_command { my ($self, $cmd, $opt, @args) = @_; local our $active_cmd = $cmd; $cmd->validate_args($opt, \@args); $cmd->execute($opt, \@args); } #pod =method plugin_search_path #pod #pod This method returns the plugin_search_path as set. The default implementation, #pod if called on "YourApp::Cmd" will return "YourApp::Cmd::Command" #pod #pod This is a method because it's fun to override it with, for example: #pod #pod use constant plugin_search_path => __PACKAGE__; #pod #pod =cut 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; } } #pod =method allow_any_unambiguous_abbrev #pod #pod If this method returns true (which, by default, it does I), then any #pod unambiguous abbreviation for a registered command name will be allowed as a #pod means to use that command. For example, given the following commands: #pod #pod reticulate #pod reload #pod rasterize #pod #pod Then the user could use C for C or C for C and #pod so on. #pod #pod =cut sub allow_any_unambiguous_abbrev { return 0 } #pod =method global_options #pod #pod if ($cmd->app->global_options->{verbose}) { ... } #pod #pod This method returns the running application's global options as a hashref. If #pod there are no options specified, an empty hashref is returned. #pod #pod =cut sub global_options { my $self = shift; return $self->{global_options} //= {} if ref $self; return {}; } #pod =method set_global_options #pod #pod $app->set_global_options(\%opt); #pod #pod This method sets the global options. #pod #pod =cut sub set_global_options { my ($self, $opt) = @_; return $self->{global_options} = $opt; } #pod =method command_names #pod #pod my @names = $cmd->command_names; #pod #pod This returns the commands names which the App::Cmd object will handle. #pod #pod =cut sub command_names { my ($self) = @_; keys $self->_command->%*; } #pod =method command_groups #pod #pod my @groups = $cmd->commands_groups; #pod #pod This method can be implemented to return a grouped list of command names with #pod optional headers. Each group is given as arrayref and each header as string. #pod If an empty list is returned, the commands plugin will show two groups without #pod headers: the first group is for the "help" and "commands" commands, and all #pod other commands are in the second group. #pod #pod =cut sub command_groups { } #pod =method command_plugins #pod #pod my @plugins = $cmd->command_plugins; #pod #pod This method returns the package names of the plugins that implement the #pod App::Cmd object's commands. #pod #pod =cut sub command_plugins { my ($self) = @_; my %seen = map {; $_ => 1 } values $self->_command->%*; keys %seen; } #pod =method plugin_for #pod #pod my $plugin = $cmd->plugin_for($command); #pod #pod This method returns the plugin (module) for the given command. If no plugin #pod implements the command, it returns false. #pod #pod =cut sub plugin_for { my ($self, $command) = @_; return unless $command; return unless exists $self->_command->{ $command }; return $self->_command->{ $command }; } #pod =method get_command #pod #pod my ($command_name, $opt, @args) = $app->get_command(@args); #pod #pod Process arguments and into a command name and (optional) global options. #pod #pod =cut sub get_command { my ($self, @args) = @_; my ($opt, $args, %fields) = $self->_process_args(\@args, $self->_global_option_processing_params); # map --help to help command if ($opt->{help}) { unshift @$args, 'help'; delete $opt->{help}; } 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/] }, ); } #pod =method usage #pod #pod print $self->app->usage->text; #pod #pod Returns the usage object for the global options. #pod #pod =cut sub usage { $_[0]{usage} }; #pod =method usage_desc #pod #pod The top level usage line. Looks something like #pod #pod "yourapp [options]" #pod #pod =cut sub usage_desc { # my ($self) = @_; # no point in creating these ops, just to toss $self return "%c %o"; } #pod =method global_opt_spec #pod #pod Returns a list with help command unless C has been specified or #pod an empty list. Can be overridden for pre-dispatch option processing. This is #pod useful for flags like --verbose. #pod #pod =cut sub global_opt_spec { my ($self) = @_; my $cmd = $self->{command}; my %seen; my @help = grep { ! $seen{$_}++ } reverse sort map { s/^--?//; $_ } grep { $cmd->{$_} eq 'App::Cmd::Command::help' } keys %$cmd; return (@help ? [ join('|', @help) => "show help" ] : ()); } #pod =method usage_error #pod #pod $self->usage_error("Something's wrong!"); #pod #pod Used to die with nice usage output, during C. #pod #pod =cut 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; } #pod =head1 TODO #pod #pod =for :list #pod * publish and bring in Log::Speak (simple quiet/verbose output) #pod * publish and use our internal enhanced describe_options #pod * publish and use our improved simple input routines #pod #pod =cut 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd - write command line apps with less suffering =head1 VERSION version 0.334 =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 abstract { "blortex algorithm" } sub description { "Long description on blortex algorithm" } 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 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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 show_version_cmd - if true, the version command will be shown in the command list 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>. By default, the version command is not included in the command list. Pass C to include the version command in the 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 abstract sub abstract { "command description" } Defines the command abstract: a short description that will be printed in the main command options list. =head2 description sub description { "Long description" } Defines a longer command description that will be shown when the user asks for help on a specific command. =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_groups my @groups = $cmd->commands_groups; This method can be implemented to return a grouped list of command names with optional headers. Each group is given as arrayref and each header as string. If an empty list is returned, the commands plugin will show two groups without headers: the first group is for the "help" and "commands" commands, and all other commands are in the second group. =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 a list with help command unless C has been specified or 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 CONTRIBUTORS =for stopwords Adam Prime ambs Andreas Hernitscheck A. Sinan Unur Chris 'BinGOs' Williams David Golden Steinbrunner Davor Cubranic Denis Ibaev Diab Jerius Glenn Fowler Ingy dot Net Jakob Voss Jérôme Quelin John SJ Anderson Karen Etheridge Kent Fredric Lucas Theisen Matthew Astley mokko Olivier Mengué Ryan C. Thompson Salvatore Bonaccorso Sergey Romanov Stephan Loyd Stephen Caldwell Yuval Kogman =over 4 =item * Adam Prime =item * ambs =item * Andreas Hernitscheck =item * A. Sinan Unur =item * Chris 'BinGOs' Williams =item * David Golden =item * David Steinbrunner =item * Davor Cubranic =item * Denis Ibaev =item * Diab Jerius =item * Glenn Fowler =item * Ingy dot Net =item * Jakob Voss =item * Jakob Voss =item * Jérôme Quelin =item * John SJ Anderson =item * Karen Etheridge =item * Kent Fredric =item * Lucas Theisen =item * Matthew Astley =item * mokko =item * Olivier Mengué =item * Ryan C. Thompson =item * Salvatore Bonaccorso =item * Sergey Romanov =item * Stephan Loyd =item * Stephen Caldwell =item * Yuval Kogman =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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.t100644000765000024 60614063251373 14752 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 51514063251373 15127 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 136114063251373 15157 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 177514063251373 15155 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 44014063251373 15106 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 140414063251373 15123 0ustar00rjbsstaff000000000000App-Cmd-0.334/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 @want = ('-f', '--fooble', 'check all foobs for foobling'); my @lines = split /\n/, $stdout; my $got; for my $line (@lines) { index($line, $_) == -1 && next for @want; $got++; } ok($got, "there's a line in help fully describing --fooble"); } unlike( $stdout, qr/commands/i, "Our simple app doesn't talk about subcommands", ); done_testing() subdispatch.t100644000765000024 135514063251373 15222 0ustar00rjbsstaff000000000000App-Cmd-0.334/t#!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use Test::Fatal; 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 } ); is( exception { $app->prepare_command( 'foo' ) }, undef, 'run default subcommand for command' ); tester-exit.t100644000765000024 114214063251373 15160 0ustar00rjbsstaff000000000000App-Cmd-0.334/t#!perl use strict; use warnings; use Test::More tests => 3; use Capture::Tiny 'capture'; require App::Cmd::Tester; # not used, but check which! my $helper_fn = $0; $helper_fn =~ s{\.t$}{.helper.pl} or die "Can't make helper from $0"; for my $exit_with (0, 5) { my ($stdout, $stderr, $got_exit) = capture { system($^X, $helper_fn, $exit_with); }; chomp $stdout; is($INC{'App/Cmd/Tester.pm'}, $stdout, "App::Cmd::Tester source path") unless $exit_with; # just once is($exit_with, $got_exit / 256, # yes it could be fractional, and that would be fail "exit code as expected"); } setup-broken.t100644000765000024 145014063251373 15323 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 47114063251373 15454 0ustar00rjbsstaff000000000000App-Cmd-0.334/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; Test000755000765000024 014063251373 14045 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/libWSOF.pm100644000765000024 40014063251373 15273 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.t100644000765000024 62014063251373 15626 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.pm100644000765000024 14714063251373 15536 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testpackage Test::MyCmd; use strict; use warnings; use parent qw(App::Cmd); our $VERSION = '0.123'; 1; WSNCC.pm100644000765000024 17614063251373 15404 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testuse strict; use warnings; package Test::WSNCC; use App::Cmd::Setup -app => { plugins => [ qw(=Test::XyzzyPlugin) ], }; 1; Cmd000755000765000024 014063251373 14106 5ustar00rjbsstaff000000000000App-Cmd-0.334/lib/AppSetup.pm100644000765000024 2017614063251373 15732 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd# The "experimental" below is not actually scary. The feature went on to be # de-experimental-ized with no changes and is now on by default in perl v5.24 # and later. -- rjbs, 2021-03-14 use 5.020; use warnings; use experimental qw(postderef postderef_qq); package App::Cmd::Setup 0.334; # ABSTRACT: helper for setting up App::Cmd classes #pod =head1 OVERVIEW #pod #pod App::Cmd::Setup is a helper library, used to set up base classes that will be #pod used as part of an App::Cmd program. For the most part you should refer to #pod L for how you should use this library. #pod #pod This class is useful in three scenarios: #pod #pod =begin :list #pod #pod = when writing your App::Cmd subclass #pod #pod Instead of writing: #pod #pod package MyApp; #pod use parent 'App::Cmd'; #pod #pod ...you can write: #pod #pod package MyApp; #pod use App::Cmd::Setup -app; #pod #pod The benefits of doing this are mostly minor, and relate to sanity-checking your #pod class. The significant benefit is that this form allows you to specify #pod plugins, as in: #pod #pod package MyApp; #pod use App::Cmd::Setup -app => { plugins => [ 'Prompt' ] }; #pod #pod Plugins are described in L and L. #pod #pod = when writing abstract base classes for commands #pod #pod That is: when you write a subclass of L that is intended for #pod other commands to use as their base class, you should use App::Cmd::Setup. For #pod example, if you want all the commands in MyApp to inherit from MyApp::Command, #pod you may want to write that package like this: #pod #pod package MyApp::Command; #pod use App::Cmd::Setup -command; #pod #pod Do not confuse this with the way you will write specific commands: #pod #pod package MyApp::Command::mycmd; #pod use MyApp -command; #pod #pod Again, this form mostly performs some validation and setup behind the scenes #pod for you. You can use C> if you prefer. #pod #pod = when writing App::Cmd plugins #pod #pod L is a mechanism that allows an App::Cmd class to inject code #pod into all its command classes, providing them with utility routines. #pod #pod To write a plugin, you must use App::Cmd::Setup. As seen above, you must also #pod use App::Cmd::Setup to set up your App::Cmd subclass if you wish to consume #pod plugins. #pod #pod For more information on writing plugins, see L and #pod L. #pod #pod =end :list #pod #pod =cut 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.334 =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 parent '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 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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.pm100644000765000024 21114063251373 15610 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testpackage Test::MyCmd2; use strict; use warnings; use parent qw(App::Cmd); sub global_opt_spec { [ 'verbose+' => "Verbosity" ], } 1; Plugin.pm100644000765000024 210514063251373 16040 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmduse strict; use warnings; package App::Cmd::Plugin 0.334; # 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.334 =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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.pm100644000765000024 2336214063251373 16063 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmduse strict; use warnings; package App::Cmd::Simple 0.334; 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; #pod =head1 SYNOPSIS #pod #pod in F: #pod #pod use YourApp::Cmd; #pod Your::Cmd->run; #pod #pod in F: #pod #pod package YourApp::Cmd; #pod use parent qw(App::Cmd::Simple); #pod #pod sub opt_spec { #pod return ( #pod [ "blortex|X", "use the blortex algorithm" ], #pod [ "recheck|r", "recheck all results" ], #pod ); #pod } #pod #pod sub validate_args { #pod my ($self, $opt, $args) = @_; #pod #pod # no args allowed but options! #pod $self->usage_error("No args allowed") if @$args; #pod } #pod #pod sub execute { #pod my ($self, $opt, $args) = @_; #pod #pod my $result = $opt->{blortex} ? blortex() : blort(); #pod #pod recheck($result) if $opt->{recheck}; #pod #pod print $result; #pod } #pod #pod and, finally, at the command line: #pod #pod knight!rjbs$ simplecmd --recheck #pod #pod All blorts successful. #pod #pod =head1 SUBCLASSING #pod #pod When writing a subclass of App::Cmd:Simple, there are only a few methods that #pod you might want to implement. They behave just like the same-named methods in #pod App::Cmd. #pod #pod =head2 opt_spec #pod #pod This method should be overridden to provide option specifications. (This is #pod list of arguments passed to C from Getopt::Long::Descriptive, #pod after the first.) #pod #pod If not overridden, it returns an empty list. #pod #pod =head2 usage_desc #pod #pod This method should be overridden to provide the top level usage line. #pod It's a one-line summary of how the command is to be invoked, and #pod should be given in the format used for the C<$usage_desc> parameter to #pod C in Getopt::Long::Descriptive. #pod #pod If not overridden, it returns something that prints out like: #pod #pod yourapp [-?h] [long options...] #pod #pod =head2 validate_args #pod #pod $cmd->validate_args(\%opt, \@args); #pod #pod This method is passed a hashref of command line options (as processed by #pod Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw #pod an exception (preferably by calling C) if they are invalid, or it #pod may do nothing to allow processing to continue. #pod #pod =head2 execute #pod #pod Your::App::Cmd::Simple->execute(\%opt, \@args); #pod #pod This method does whatever it is the command should do! It is passed a hash #pod reference of the parsed command-line options and an array reference of left #pod over arguments. #pod #pod =cut # 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 { } #pod =head1 WARNINGS #pod #pod B Although it is probably not going #pod to change much, don't build your business model around it yet, okay? #pod #pod App::Cmd::Simple is not rich in black magic, but it does do some somewhat #pod gnarly things to make an App::Cmd::Simple look as much like an #pod App::Cmd::Command as possible. This means that you can't deviate too much from #pod the sort of thing shown in the synopsis as you might like. If you're doing #pod something other than writing a fairly simple command, and you want to screw #pod around with the App::Cmd-iness of your program, Simple might not be the best #pod choice. #pod #pod B if you are writing a program with the #pod App::Cmd::Simple class embedded in it, you B call import on the class. #pod That's how things work. You can just do this: #pod #pod YourApp::Cmd->import->run; #pod #pod =cut 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Simple - a helper for building one-command App::Cmd applications =head1 VERSION version 0.334 =head1 SYNOPSIS in F: use YourApp::Cmd; Your::Cmd->run; in F: package YourApp::Cmd; use parent 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 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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 usage_desc This method should be overridden to provide the top level usage line. It's a one-line summary of how the command is to be invoked, and should be given in the format used for the C<$usage_desc> parameter to C in Getopt::Long::Descriptive. If not overridden, it returns something that prints out like: yourapp [-?h] [long options...] =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) 2021 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.pm100644000765000024 1627114063251373 16101 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmduse strict; use warnings; package App::Cmd::Tester 0.334; # ABSTRACT: for capturing the result of running an app #pod =head1 SYNOPSIS #pod #pod use Test::More tests => 4; #pod use App::Cmd::Tester; #pod #pod use YourApp; #pod #pod my $result = test_app(YourApp => [ qw(command --opt value) ]); #pod #pod like($result->stdout, qr/expected output/, 'printed what we expected'); #pod #pod is($result->stderr, '', 'nothing sent to sderr'); #pod #pod is($result->error, undef, 'threw no exceptions'); #pod #pod my $result = test_app(YourApp => [ qw(command --opt value --quiet) ]); #pod #pod is($result->output, '', 'absolutely no output with --quiet'); #pod #pod =head1 DESCRIPTION #pod #pod One of the reasons that user-executed programs are so often poorly tested is #pod that they are hard to test. App::Cmd::Tester is one of the tools App-Cmd #pod provides to help make it easy to test App::Cmd-based programs. #pod #pod It provides one routine: test_app. #pod #pod =method test_app #pod #pod B: while C is a method, it is by default exported as a #pod subroutine into the namespace that uses App::Cmd::Tester. In other words: you #pod probably don't need to think about this as a method unless you want to subclass #pod App::Cmd::Tester. #pod #pod my $result = test_app($app_class => \@argv_contents); #pod #pod This will locally set C<@ARGV> to simulate command line arguments, and will #pod then call the C method on the given application class (or application). #pod Output to the standard output and standard error filehandles will be captured. #pod #pod C<$result> is an App::Cmd::Tester::Result object, which has methods to access #pod the following data: #pod #pod stdout - the output sent to stdout #pod stderr - the output sent to stderr #pod output - the combined output of stdout and stderr #pod error - the exception thrown by running the application, or undef #pod run_rv - the return value of the run method (generally irrelevant) #pod exit_code - the numeric exit code that would've been issued (0 is 'okay') #pod #pod The output is captured using L, which I ensure that the #pod ordering is preserved in the combined output, but I capture the output #pod of external programs. You can reverse these tradeoffs by using #pod L instead. #pod #pod =cut 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 { my ($rc) = @_; return CORE::exit($rc) unless $TEST_IN_PROGRESS; App::Cmd::Tester::Exited->throw($rc); }; } #pod =for Pod::Coverage result_class #pod #pod =cut 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 0.334; 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 0.334; 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.334 =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 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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') The output is captured using L, which I ensure that the ordering is preserved in the combined output, but I capture the output of external programs. You can reverse these tradeoffs by using L instead. =for Pod::Coverage result_class =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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 00-report-prereqs.t100644000765000024 1345214063251373 16141 0ustar00rjbsstaff000000000000App-Cmd-0.334/t#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.028 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: Command.pm100644000765000024 2525114063251373 16207 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmduse strict; use warnings; package App::Cmd::Command 0.334; use App::Cmd::ArgProcessor; BEGIN { our @ISA = 'App::Cmd::ArgProcessor' }; # ABSTRACT: a base class for App::Cmd commands use Carp (); #pod =method prepare #pod #pod my ($cmd, $opt, $args) = $class->prepare($app, @args); #pod #pod This method is the primary way in which App::Cmd::Command objects are built. #pod Given the remaining command line arguments meant for the command, it returns #pod the Command object, parsed options (as a hashref), and remaining arguments (as #pod an arrayref). #pod #pod In the usage above, C<$app> is the App::Cmd object that is invoking the #pod command. #pod #pod =cut 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), ); } #pod =method new #pod #pod This returns a new instance of the command plugin. Probably only C #pod should use this. #pod #pod =cut sub new { my ($class, $arg) = @_; bless $arg => $class; } #pod =method execute #pod #pod $command_plugin->execute(\%opt, \@args); #pod #pod This method does whatever it is the command should do! It is passed a hash #pod reference of the parsed command-line options and an array reference of left #pod over arguments. #pod #pod If no C method is defined, it will try to call C -- but it will #pod warn about this behavior during testing, to remind you to fix the method name! #pod #pod =cut 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"; } #pod =method app #pod #pod This method returns the App::Cmd object into which this command is plugged. #pod #pod =cut sub app { $_[0]->{app}; } #pod =method usage #pod #pod This method returns the usage object for this command. (See #pod L). #pod #pod =cut sub usage { $_[0]->{usage}; } #pod =method command_names #pod #pod This method returns a list of command names handled by this plugin. The #pod first item returned is the 'canonical' name of the command. #pod #pod If this method is not overridden by an App::Cmd::Command subclass, it will #pod return the last part of the plugin's package name, converted to lowercase. #pod For example, YourApp::Cmd::Command::Init will, by default, handle the command #pod "init". #pod #pod Subclasses should generally get the superclass value of C #pod and then append aliases. #pod #pod =cut sub command_names { # from UNIVERSAL::moniker (ref( $_[0] ) || $_[0]) =~ /([^:]+)$/; return lc $1; } #pod =method usage_desc #pod #pod This method should be overridden to provide a usage string. (This is the first #pod argument passed to C from Getopt::Long::Descriptive.) #pod #pod If not overridden, it returns "%c COMMAND %o"; COMMAND is the first item in #pod the result of the C method. #pod #pod =cut sub usage_desc { my ($self) = @_; my ($command) = $self->command_names; return "%c $command %o" } #pod =method opt_spec #pod #pod This method should be overridden to provide option specifications. (This is #pod list of arguments passed to C from Getopt::Long::Descriptive, #pod after the first.) #pod #pod If not overridden, it returns an empty list. #pod #pod =cut sub opt_spec { return; } #pod =method validate_args #pod #pod $command_plugin->validate_args(\%opt, \@args); #pod #pod This method is passed a hashref of command line options (as processed by #pod Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw #pod an exception (preferably by calling C, below) if they are invalid, #pod or it may do nothing to allow processing to continue. #pod #pod =cut sub validate_args { } #pod =method usage_error #pod #pod $self->usage_error("This command must not be run by root!"); #pod #pod This method should be called to die with human-friendly usage output, during #pod C. #pod #pod =cut 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 }; } #pod =method abstract #pod #pod This method returns a short description of the command's purpose. If this #pod method is not overridden, it will return the abstract from the module's Pod. #pod If it can't find the abstract, it will look for a comment starting with #pod "ABSTRACT:" like the ones used by L. #pod #pod =cut # 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)"; } #pod =method description #pod #pod This method can be overridden to provide full option description. It #pod is used by the built-in L command. #pod #pod If not overridden, it uses L to extract the description #pod from the module's Pod DESCRIPTION section or the empty string. #pod #pod =cut sub description { my ($class) = @_; $class = ref $class if ref $class; # classname to filename (my $pm_file = $class) =~ s!::!/!g; $pm_file .= '.pm'; $pm_file = $INC{$pm_file} or return ''; open my $input, "<", $pm_file or return ''; my $descr = ""; open my $output, ">", \$descr; require Pod::Usage; Pod::Usage::pod2usage( -input => $input, -output => $output, -exit => "NOEXIT", -verbose => 99, -sections => "DESCRIPTION", indent => 0 ); $descr =~ s/Description:\n//m; chomp $descr; return $descr; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Command - a base class for App::Cmd commands =head1 VERSION version 0.334 =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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 can be overridden to provide full option description. It is used by the built-in L command. If not overridden, it uses L to extract the description from the module's Pod DESCRIPTION section or the empty string. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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.pm100644000765000024 63214063251373 16263 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testpackage Test::MySimple; use strict; use warnings; use parent '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; author000755000765000024 014063251373 14052 5ustar00rjbsstaff000000000000App-Cmd-0.334/xtpod-syntax.t100644000765000024 25214063251373 16464 0ustar00rjbsstaff000000000000App-Cmd-0.334/xt/author#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 00-report-prereqs.dd100644000765000024 505214063251373 16242 0ustar00rjbsstaff000000000000App-Cmd-0.334/tdo { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '6.78' } }, 'develop' => { 'requires' => { 'Encode' => '0', 'Test::More' => '0', 'Test::Pod' => '1.41' } }, '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', 'Pod::Usage' => '1.61', 'String::RewritePrefix' => '0', 'Sub::Exporter' => '0', 'Sub::Exporter::Util' => '0', 'Sub::Install' => '0', 'Text::Abbrev' => '0', 'constant' => '0', 'experimental' => '0', 'parent' => '0', 'perl' => '5.020', 'strict' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'Data::Dumper' => '0', 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'IPC::Cmd' => '0', 'Test::Fatal' => '0', 'Test::More' => '0.96', 'lib' => '0' } } }; $x; }BrokenCmd.pm100644000765000024 12214063251373 16362 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testuse strict; use warnings; package Test::BrokenCmd; use App::Cmd::Setup -app; 1; WithSetup.pm100644000765000024 20214063251373 16451 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testuse strict; use warnings; package Test::WithSetup; use App::Cmd::Setup -app => { plugins => [ qw(=Test::XyzzyPlugin) ], }; 1; tester-exit.helper.pl100755000765000024 25014063251373 16570 0ustar00rjbsstaff000000000000App-Cmd-0.334/t#!perl use strict; use warnings; use App::Cmd::Tester; my ($exit_with) = @ARGV; print "$INC{'App/Cmd/Tester.pm'}\n"; exit $exit_with; # nb. the App::Cmd::Tester one Tutorial.pod100644000765000024 5070514063251373 16604 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd #pod =head1 DESCRIPTION #pod #pod App::Cmd is a set of tools designed to make it simple to write sophisticated #pod command line programs. It handles commands with multiple subcommands, #pod generates usage text, validates options, and lets you write your program as #pod easy-to-test classes. #pod #pod An App::Cmd-based application is made up of three main parts: the script, #pod the application class, and the command classes. #pod #pod =head2 The Script #pod #pod The script is the actual executable file run at the command line. It can #pod generally consist of just a few lines: #pod #pod #!/usr/bin/perl #pod use YourApp; #pod YourApp->run; #pod #pod =head2 The Application Class #pod #pod All the work of argument parsing, validation, and dispatch is taken care of by #pod your application class. The application class can also be pretty simple, and #pod might look like this: #pod #pod package YourApp; #pod use App::Cmd::Setup -app; #pod 1; #pod #pod When a new application instance is created, it loads all of the command classes #pod it can find, looking for modules under the Command namespace under its own #pod name. In the above snippet, for example, YourApp will look for any module with #pod a name starting with C. #pod #pod =head2 The Command Classes #pod #pod We can set up a simple command class like this: #pod #pod # ABSTRACT: set up YourApp #pod package YourApp::Command::initialize; #pod use YourApp -command; #pod 1; #pod #pod Now, a user can run this command, but he'll get an error: #pod #pod $ yourcmd initialize #pod YourApp::Command::initialize does not implement mandatory method 'execute' #pod #pod Oops! This dies because we haven't told the command class what it should do #pod when executed. This is easy, we just add some code: #pod #pod sub execute { #pod my ($self, $opt, $args) = @_; #pod #pod print "Everything has been initialized. (Not really.)\n"; #pod } #pod #pod Now it works: #pod #pod $ yourcmd initialize #pod Everything has been initialized. (Not really.) #pod #pod =head2 Default Commands #pod #pod By default applications made with App::Cmd know two commands: C and #pod C. #pod #pod =over #pod #pod =item commands #pod #pod lists available commands. #pod #pod $yourcmd commands #pod Available commands: #pod #pod commands: list the application's commands #pod help: display a command's help screen #pod #pod init: set up YourApp #pod #pod Note that by default the commands receive a description from the C<# ABSTRACT> #pod comment in the respective command's module, or from the C<=head1 NAME> Pod #pod section. #pod #pod =item help #pod #pod allows one to query for details on command's specifics. #pod #pod $yourcmd help initialize #pod yourcmd initialize [-z] [long options...] #pod #pod -z --zero ignore zeros #pod #pod Of course, it's possible to disable or change the default commands, see #pod L. #pod #pod =back #pod #pod =head2 Arguments and Options #pod #pod In this example #pod #pod $ yourcmd reset -zB --new-seed xyzzy foo.db bar.db #pod #pod C<-zB> and C<--new-seed xyzzy> are "options" and C and C #pod are "arguments." #pod #pod With a properly configured command class, the above invocation results in #pod nicely formatted data: #pod #pod $opt = { #pod zero => 1, #pod no_backup => 1, #default value #pod new_seed => 'xyzzy', #pod }; #pod #pod $args = [ qw(foo.db bar.db) ]; #pod #pod Arguments are processed by L (GLD). To customize #pod its argument processing, a command class can implement a few methods: #pod C provides the usage format string; C provides the option #pod specification list; C is run after Getopt::Long::Descriptive, #pod and is meant to validate the C<$args>, which GLD ignores. See L #pod for format specifications. #pod #pod The first two methods provide configuration passed to GLD's C #pod routine. To improve our command class, we might add the following code: #pod #pod sub usage_desc { "yourcmd %o [dbfile ...]" } #pod #pod sub opt_spec { #pod return ( #pod [ "skip-refs|R", "skip reference checks during init", ], #pod [ "values|v=s@", "starting values", { default => [ 0, 1, 3 ] } ], #pod ); #pod } #pod #pod sub validate_args { #pod my ($self, $opt, $args) = @_; #pod #pod # we need at least one argument beyond the options; die with that message #pod # and the complete "usage" text describing switches, etc #pod $self->usage_error("too few arguments") unless @$args; #pod } #pod #pod =head2 Global Options #pod #pod There are several ways of making options available everywhere (globally). This #pod recipe makes local options accessible in all commands. #pod #pod To add a C<--help> option to all your commands create a base class like: #pod #pod package MyApp::Command; #pod use App::Cmd::Setup -command; #pod #pod sub opt_spec { #pod my ( $class, $app ) = @_; #pod return ( #pod [ 'help' => "this usage screen" ], #pod $class->options($app), #pod ) #pod } #pod #pod sub validate_args { #pod my ( $self, $opt, $args ) = @_; #pod if ( $opt->{help} ) { #pod my ($command) = $self->command_names; #pod $self->app->execute_command( #pod $self->app->prepare_command("help", $command) #pod ); #pod exit; #pod } #pod $self->validate( $opt, $args ); #pod } #pod #pod Where C and C are "inner" methods which your command #pod subclasses implement to provide command-specific options and validation. #pod #pod Note: this is a new file, previously not mentioned in this tutorial and this #pod tip does not recommend the use of global_opt_spec which offers an alternative #pod way of specifying global options. #pod #pod =head1 TIPS #pod #pod =over 4 #pod #pod =item * #pod #pod Delay using large modules using L, L or C in #pod your commands to save memory and make startup faster. Since only one of these #pod commands will be run anyway, there's no need to preload the requirements for #pod all of them. #pod #pod =item * #pod #pod Add a C method to your commands for more verbose output #pod from the built-in L command. #pod #pod sub description { #pod return "The initialize command prepares ..."; #pod } #pod #pod =item * #pod #pod To let your users configure default values for options, put a sub like #pod #pod sub config { #pod my $app = shift; #pod $app->{config} ||= TheLovelyConfigModule->load_config_file(); #pod } #pod #pod in your main app file, and then do something like: #pod #pod package YourApp; #pod sub opt_spec { #pod my ( $class, $app ) = @_; #pod my ( $name ) = $class->command_names; #pod return ( #pod [ 'blort=s' => "That special option", #pod { default => $app->config->{$name}{blort} || $fallback_default }, #pod ], #pod ); #pod } #pod #pod Or better yet, put this logic in a superclass and process the return value from #pod an "inner" method: #pod #pod package YourApp::Command; #pod sub opt_spec { #pod my ( $class, $app ) = @_; #pod return ( #pod [ 'help' => "this usage screen" ], #pod $class->options($app), #pod ) #pod } #pod #pod #pod =item * #pod #pod You need to activate C and C as usual if you want them. #pod App::Cmd doesn't do that for you. #pod #pod =back #pod #pod =head1 IGNORING THINGS #pod #pod Some people find that for whatever reason, they wish to put Modules in their #pod C namespace which are not commands, or not commands intended #pod for use by C. #pod #pod Good examples include, but are not limited to, things like #pod C, where C<::Quietly> is only #pod useful for the C command. #pod #pod The default behaviour is to treat such packages as errors, as for the majority #pod of use cases, things in C<::Command> are expected to I be commands, and #pod thus, anything that, by our heuristics, is not a command, is highly likely to be #pod a mistake. #pod #pod And as all commands are loaded simultaneously, an error in any one of these #pod commands will yield a fatal error. #pod #pod There are a few ways to specify that you are sure you want to do this, with #pod varying ranges of scope and complexity. #pod #pod =head2 Ignoring a Single Module. #pod #pod This is the simplest approach, and most useful for one-offs. #pod #pod package YourApp::Command::foo::NotACommand; #pod #pod use YourApp -ignore; #pod #pod #pod #pod This will register this package's namespace with YourApp to be excluded from #pod its plugin validation magic. It otherwise makes no changes to #pod C<::NotACommand>'s namespace, does nothing magical with C<@ISA>, and doesn't #pod bolt any hidden functions on. #pod #pod Its also probably good to notice that it is ignored I by #pod C. If for whatever reason you have two different C systems #pod under which C<::NotACommand> is visible, you'll need to set it ignored to both. #pod #pod This is probably a big big warning B to do that. #pod #pod =head2 Ignoring Multiple modules from the App level. #pod #pod If you really fancy it, you can override the C method provided by #pod C to tweak its ignore logic. The most useful example of this is as #pod follows: #pod #pod sub should_ignore { #pod my ( $self, $command_class ) = @_; #pod return 1 if not $command_class->isa( 'App::Cmd::Command' ); #pod return; #pod } #pod #pod This will prematurely mark for ignoring all packages that don't subclass #pod C, which causes non-commands ( or perhaps commands that are #pod coded wrongly / broken ) to be silently skipped. #pod #pod Note that by overriding this method, you will lose the effect of any of the #pod other ignore mechanisms completely. If you want to combine the original #pod C method with your own logic, you'll want to steal C's #pod C method modifier. #pod #pod use Moose::Util; #pod #pod Moose::Util::add_method_modifier( __PACKAGE__, 'around', [ #pod should_ignore => sub { #pod my $orig = shift; #pod my $self = shift; #pod return 1 if not $command_class->isa( 'App::Cmd::Command' ); #pod return $self->$orig( @_ ); #pod }]); #pod #pod =head1 SEE ALSO #pod #pod L #pod #pod =cut # 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.334 =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 xyzzy foo.db bar.db C<-zB> and C<--new-seed xyzzy> 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 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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) 2021 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.pm100644000765000024 17614063251373 16662 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testpackage Test::MyCmdAbbrev; use strict; use warnings; use parent qw{ App::Cmd }; sub allow_any_unambiguous_abbrev { 1 } 1; XyzzyPlugin.pm100644000765000024 31114063251373 17052 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.pm100644000765000024 721414063251373 17061 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd# The "experimental" below is not actually scary. The feature went on to be # de-experimental-ized with no changes and is now on by default in perl v5.24 # and later. -- rjbs, 2021-03-14 use 5.020; use warnings; use experimental qw(postderef postderef_qq); package App::Cmd::Subdispatch 0.334; 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 #pod =method new #pod #pod A hackish new that allows us to have an Command instance before they normally #pod exist. #pod #pod =cut sub new { my ($inv, $fields, @args) = @_; if (ref $inv) { @{ $inv }{ keys %$fields } = values %$fields; return $inv; } else { $inv->SUPER::new($fields, @args); } } #pod =method prepare #pod #pod my $subcmd = $subdispatch->prepare($app, @args); #pod #pod An overridden version of L that performs a new #pod dispatch cycle. #pod #pod =cut 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); } #pod =method app #pod #pod $subdispatch->app; #pod #pod This method returns the application that this subdispatch is a command of. #pod #pod =cut sub app { $_[0]{app} } #pod =method choose_parent_app #pod #pod $subcmd->prepare( #pod $subdispatch->choose_parent_app($app, $opt, $plugin), #pod @$args #pod ); #pod #pod A method that chooses whether the parent app or the subdispatch is going to be #pod C<< $cmd->app >>. #pod #pod =cut sub choose_parent_app { my ( $self, $app, $plugin ) = @_; if ( $plugin->isa("App::Cmd::Command::commands") or $plugin->isa("App::Cmd::Command::help") or 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.334 =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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) 2021 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.pm100644000765000024 12514063251373 17051 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testuse strict; use warnings; package Test::WithCallback; use App::Cmd::Setup -app; 1; ArgProcessor.pm100644000765000024 246514063251373 17224 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmduse strict; use warnings; package App::Cmd::ArgProcessor 0.334; # 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.334 =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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 Command000755000765000024 014063251373 15464 5ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmdhelp.pm100644000765000024 1270714063251373 17141 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd/Commanduse strict; use warnings; package App::Cmd::Command::help 0.334; use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command'; } # ABSTRACT: display a command's help screen #pod =head1 DESCRIPTION #pod #pod This command will either list all of the application commands and their #pod abstracts, or display the usage screen for a subcommand with its #pod description. #pod #pod =head1 USAGE #pod #pod The help text is generated from three sources: #pod #pod =for :list #pod * The C method #pod * The C method #pod * The C data structure #pod #pod The C method provides the opening usage line, following the #pod specification described in L. In some cases, #pod the default C in L may be sufficient and #pod you will only need to override it to provide additional command line #pod usage information. #pod #pod The C data structure is used with L #pod to generate the description of the options. #pod #pod Subcommand classes should override the C method to provide #pod additional information that is prepended before the option descriptions. #pod #pod For example, consider the following subcommand module: #pod #pod package YourApp::Command::initialize; #pod #pod # This is the default from App::Cmd::Command #pod sub usage_desc { #pod my ($self) = @_; #pod my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o" #pod return "$desc [DIRECTORY]"; #pod } #pod #pod sub description { #pod return "The initialize command prepares the application..."; #pod } #pod #pod sub opt_spec { #pod return ( #pod [ "skip-refs|R", "skip reference checks during init", ], #pod [ "values|v=s@", "starting values", { default => [ 0, 1, 3 ] } ], #pod ); #pod } #pod #pod ... #pod #pod That module would generate help output like this: #pod #pod $ yourapp help initialize #pod yourapp initialize [-Rv] [long options...] [DIRECTORY] #pod #pod The initialize command prepares the application... #pod #pod --help This usage screen #pod -R --skip-refs skip reference checks during init #pod -v --values starting values #pod #pod =cut sub usage_desc { '%c help [subcommand]' } sub command_names { qw/help --help -h -?/ } sub execute { my ($self, $opts, $args) = @_; if (!@$args) { print $self->app->usage->text . "\n"; print "Available commands:\n\n"; $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.334 =head1 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. =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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) 2021 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.pm100644000765000024 12614063251373 17244 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Testuse strict; use warnings; package Test::IgnoreCommand; use App::Cmd::Setup -app; 1; version.pm100644000765000024 316214063251373 17651 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd/Commanduse strict; use warnings; package App::Cmd::Command::version 0.334; use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command'; } # ABSTRACT: display an app's version #pod =head1 DESCRIPTION #pod #pod This command will display the program name, its base class #pod with version number, and the full program name. #pod #pod =cut 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.334 =head1 DESCRIPTION This command will display the program name, its base class with version number, and the full program name. =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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.pm100644000765000024 777714063251373 20005 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd/Commanduse strict; use warnings; package App::Cmd::Command::commands 0.334; use App::Cmd::Command; BEGIN { our @ISA = 'App::Cmd::Command' }; # ABSTRACT: list the application's commands #pod =head1 DESCRIPTION #pod #pod This command will list all of the application commands available and their #pod abstracts. #pod #pod =method execute #pod #pod This is the command's primary method and raison d'etre. It prints the #pod application's usage text (if any) followed by a sorted listing of the #pod application's commands and their abstracts. #pod #pod The commands are printed in sorted groups (created by C); each #pod group is set off by blank lines. #pod #pod =cut sub execute { my ($self, $opt, $args) = @_; my $target = $opt->stderr ? *STDERR : *STDOUT; my @cmd_groups = $self->app->command_groups; my @primary_commands = map { @$_ if ref $_ } @cmd_groups; if (!@cmd_groups) { @primary_commands = grep { $_ ne 'version' or $self->app->{show_version} } map { ($_->command_names)[0] } $self->app->command_plugins; @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) { if (!ref $cmd_set) { print { $target } "$cmd_set:\n"; next; } 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"; } } #pod =method C #pod #pod my @sorted = $cmd->sort_commands(@unsorted); #pod #pod This method orders the list of commands into groups which it returns as a list of #pod arrayrefs, and optional group header strings. #pod #pod By default, the first group is for the "help" and "commands" commands, and all #pod other commands are in the second group. #pod #pod This method can be overridden by implementing the C method in #pod your application base clase. #pod #pod =cut 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' ], ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Cmd::Command::commands - list the application's commands =head1 VERSION version 0.334 =head1 DESCRIPTION This command will list all of the application commands available and their abstracts. =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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 groups which it returns as a list of arrayrefs, and optional group header strings. By default, the first group is for the "help" and "commands" commands, and all other commands are in the second group. This method can be overridden by implementing the C method in your application base clase. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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 BrokenCmd000755000765000024 014063251373 15711 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/TestCommand.pm100644000765000024 15714063251373 17750 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/BrokenCmduse strict; use warnings; package Test::BrokenCmd::Command; use App::Cmd::Setup -command; die "BROKEN"; 1; WithSetup000755000765000024 014063251373 16001 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/TestCommand.pm100644000765000024 13514063251373 20034 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/WithSetupuse strict; use warnings; package Test::WithSetup::Command; use App::Cmd::Setup -command; 1; Command000755000765000024 014063251373 16434 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmdexit.pm100644000765000024 47214063251373 20066 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::exit; use strict; use warnings; use parent qw(App::Cmd::Command); =head1 NAME Test::MyCmd::Command::exit - exit with a given value =head1 DESCRIPTION This package exists to exiting with exit(); =cut sub execute { my ($self, $opt, $args) = @_; exit($args->[0] // 0); } 1; Command000755000765000024 014063251373 16516 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd2foo.pm100644000765000024 27714063251373 17765 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd2/Commandpackage Test::MyCmd2::Command::foo; use parent qw/App::Cmd::Subdispatch/; use constant plugin_search_path => __PACKAGE__; use constant global_opt_spec => ( [ 'moose' => "lefoo" ], ); 1; release000755000765000024 014063251373 14170 5ustar00rjbsstaff000000000000App-Cmd-0.334/xtchanges_has_content.t100644000765000024 210114063251373 20504 0ustar00rjbsstaff000000000000App-Cmd-0.334/xt/releaseuse Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '0.334'; my $trial_token = '-TRIAL'; my $encoding = 'UTF-8'; 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; 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>); if ($encoding) { require Encode; $changelog = Encode::decode($encoding, $changelog, Encode::FB_CROAK()); } 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.pm100644000765000024 63014063251373 20214 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::hello; use strict; use warnings; use parent 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.pm100644000765000024 37514063251373 20242 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::stock; use strict; use warnings; use parent 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; Command000755000765000024 014063251373 16300 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/WSNCCblort.pm100644000765000024 23514063251373 20100 0ustar00rjbsstaff000000000000App-Cmd-0.334/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; IgnoreCommand000755000765000024 014063251373 16567 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/TestCommand.pm100644000765000024 20414063251373 20617 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/IgnoreCommanduse strict; use warnings; package Test::IgnoreCommand::Command; use Test::IgnoreCommand -ignore; sub foo { return "hi"; } 1; foo000755000765000024 014063251373 17301 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd2/Commandbar.pm100644000765000024 20514063251373 20520 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd2/Command/foopackage Test::MyCmd2::Command::foo::bar; use parent qw/App::Cmd::Command/; use constant opt_spec => ( [ foo => "lefoo" ], ); 1; Tester000755000765000024 014063251373 15354 5ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/CmdCaptureExternal.pm100644000765000024 764114063251373 21170 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd/Testeruse strict; use warnings; package App::Cmd::Tester::CaptureExternal 0.334; use parent 'App::Cmd::Tester'; use Capture::Tiny 0.13 qw/capture/; # ABSTRACT: Extends App::Cmd::Tester to capture from external subprograms #pod =head1 SYNOPSIS #pod #pod use Test::More tests => 4; #pod use App::Cmd::Tester::CaptureExternal; #pod #pod use YourApp; #pod #pod my $result = test_app(YourApp => [ qw(command --opt value) ]); #pod #pod like($result->stdout, qr/expected output/, 'printed what we expected'); #pod #pod is($result->stderr, '', 'nothing sent to sderr'); #pod #pod ok($result->output, "STDOUT concatenated with STDERR"); #pod #pod =head1 DESCRIPTION #pod #pod L provides a useful scaffold for testing applications, but it #pod is unable to capture output generated from any external subprograms that are #pod invoked from the application. #pod #pod This subclass uses an alternate mechanism for capturing output #pod (L) that does capture from external programs, with one #pod major limitation. #pod #pod It is not possible to capture externally from both STDOUT and STDERR while #pod also having appropriately interleaved combined output. Therefore, the #pod C from this subclass simply concatenates the two. #pod #pod You can still use C for testing if there is any output at all or for #pod testing if something appeared in either output stream, but you can't rely on #pod the ordering being correct between lines to STDOUT and lines to STDERR. #pod #pod =cut 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.334 =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 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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.pm100644000765000024 61014063251373 21072 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::frobulate; use strict; use warnings; use parent 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.pm100644000765000024 42714063251373 21127 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmd/Commandpackage Test::MyCmd::Command::justusage; use strict; use warnings; use parent 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; Command000755000765000024 014063251373 17556 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmdAbbrevbar.pm100644000765000024 15514063251373 21001 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmdAbbrev/Commandpackage Test::MyCmdAbbrev::Command::bar; use strict; use warnings; use parent qw{ App::Cmd::Command }; 1; baz.pm100644000765000024 15514063251373 21011 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmdAbbrev/Commandpackage Test::MyCmdAbbrev::Command::baz; use strict; use warnings; use parent qw{ App::Cmd::Command }; 1; foo.pm100644000765000024 15514063251373 21020 0ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/MyCmdAbbrev/Commandpackage Test::MyCmdAbbrev::Command::foo; use strict; use warnings; use parent qw{ App::Cmd::Command }; 1; Command000755000765000024 014063251373 17357 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/WithSetupalfie.pm100644000765000024 24514063251373 21116 0ustar00rjbsstaff000000000000App-Cmd-0.334/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; Subdispatch000755000765000024 014063251373 16357 5ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/CmdDashedStyle.pm100644000765000024 503214063251373 21266 0ustar00rjbsstaff000000000000App-Cmd-0.334/lib/App/Cmd/Subdispatchuse strict; use warnings; package App::Cmd::Subdispatch::DashedStyle 0.334; use App::Cmd::Subdispatch; BEGIN { our @ISA = 'App::Cmd::Subdispatch' }; # ABSTRACT: "app cmd --subcmd" style subdispatching #pod =method get_command #pod #pod my ($subcommand, $opt, $args) = $subdispatch->get_command(@args) #pod #pod A version of get_command that chooses commands as options in the following #pod style: #pod #pod mytool mycommand --mysubcommand #pod #pod =cut 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); } } #pod =method opt_spec #pod #pod A version of C that calculates the getopt specification from the #pod subcommands. #pod #pod =cut 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.334 =head1 PERL VERSION SUPPORT This module has a long-term perl support period. That means it will not require a version of perl released fewer than five years ago. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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 Command000755000765000024 014063251373 17753 5ustar00rjbsstaff000000000000App-Cmd-0.334/t/lib/Test/WithCallbacklol.pm100644000765000024 47514063251373 21225 0ustar00rjbsstaff000000000000App-Cmd-0.334/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.pm100644000765000024 26414063251373 21311 0ustar00rjbsstaff000000000000App-Cmd-0.334/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;