Commandable-0.14000755001750001750 014667075260 12376 5ustar00leoleo000000000000Commandable-0.14/.editorconfig000444001750001750 5314667075260 15146 0ustar00leoleo000000000000root = true [*.{pm,pl,t}] indent_size = 3 Commandable-0.14/Build.PL000444001750001750 77014667075260 14013 0ustar00leoleo000000000000use v5; use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Commandable', configure_requires => { 'Module::Build' => "0.4004", # test_requires }, requires => { 'perl' => '5.026', 'experimental' => 0, 'meta' => '0.003_003', 'Module::Pluggable::Object' => 0, }, test_requires => { 'Test2::V0' => 0, }, license => 'perl', create_license => 1, create_readme => 1, ); $build->create_build_script; Commandable-0.14/Changes000444001750001750 1010014667075260 14036 0ustar00leoleo000000000000Revision history for Commandable 0.14 2024-09-07 [CHANGES] * Support discovering global options as attributes on package scalar variables in the SubAttributes finder 0.13 2024-09-01 [CHANGES] * Added `->add_global_options` method to support global options * Support `=u` (unsigned) and `=f` (float) option types as well as arbitrary regexp match validation [BUGFIXES] * Ensure that hyphens are converted to underscores when setting default values for options * Ensure that mode=bool options always have a defined value, even if false 0.12 2024-08-21 [CHANGES] * Moved `->parse_invocation` out of Command into Finder * Optional additional help text generated by the package that implements a given command * Use `meta` instead of `no strict refs` hackery * Avoid Test::NoWarnings 0.11 2023-06-08 [CHANGES] * Added `$finder->find_and_invoke_list` convenience * Print information about `[no-]` prefix for negatable options in `help` output * Optionally require that options all come before non-option arguments * Optionally allow bundling of single-letter boolean options * Convert hyphens in option names to underscores when inserting their value into the options hash * Support integer-type checking in options * Added various docs [BUGFIXES] * Ensure that `$cinv->putback_tokens` escapes quotes 0.10 2023-04-29 [CHANGES] * Add more types of option - negatable, incrementable, multi-value (much thanks to ilmari) * Use trailing `=` to indicate option names with values; to match Getopt::Long * Swap all unit tests from `Test::More` to `Test2::V0` 0.09 2022-12-04 [CHANGES] * Added Commandable::Finder::MethodAttributes for handling commands provided by an object instance by capturing the instance itself in the code refs 0.08 2022-07-13 [CHANGES] * Allow "slurpy" arguments * Added ->configure method to Finder, adding configuration options * Optionally permit multiple command invocations in one line [BUGFIXES] * Ensure the ->code field of Command instances is set by all Finder subclasses 0.07 2022-04-25 [CHANGES] * Initial version of Commandable::Output API, an interface for user programs to customise the way output is displayed * Ensure that the 'help' builtin command uses Commandable::Output for all its printing * Convert underscores to hyphens in command names for Commandable::Finder::SubAttributes * More documentation on how to use Commandable::Finder::Packages 0.06 2021-11-03 [CHANGES] * Initial support for declaring named options to commands * Also parse out commandline options * Include options in `help` output 0.05 2021-10-10 [CHANGES] * Added Commandable::Finder::SubAttributes * Document the Commandable::Command result structure * Initial support for declaring positional arguments to commands * Assist with parsing command arguments out of invocation instances * Provide automatic built-in `help` command * Added some convenient wrappers for commandline scripts: + Commandable::Finder::SubAttributes->new_for_main + Commandable::Finder->find_and_invoke_ARGV 0.04 2020-01-20 18:51:50 [CHANGES] * Renamed $inv->remaining to ->peek_remaining * Added Commandable::Finder::Packages 0.03 2018-10-16 17:22:16 [CHANGES] * Added ->new_from_tokens 0.02 2018-07-29 23:39:17 [CHANGES] * Added ->putback_tokens [BUGFIXES] * Make sure that "multiple" "quotes" are parsed correctly 0.01 2018-06-07 13:10:15 Initial version with just Commandable::Invocation Commandable-0.14/LICENSE000444001750001750 4653414667075260 13574 0ustar00leoleo000000000000This software is copyright (c) 2024 by Paul Evans . 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) 2024 by Paul Evans . 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 Perl Artistic License 1.0 --- This software is Copyright (c) 2024 by Paul Evans . This is free software, licensed under: The Perl 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 as specified below. "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 uunet.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) give non-standard executables non-standard names, and clearly document 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. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 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 whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Commandable-0.14/MANIFEST000444001750001750 123214667075260 13662 0ustar00leoleo000000000000.editorconfig Build.PL Changes lib/Commandable.pm lib/Commandable/Command.pm lib/Commandable/Finder.pm lib/Commandable/Finder/MethodAttributes.pm lib/Commandable/Finder/Packages.pm lib/Commandable/Finder/SubAttributes.pm lib/Commandable/Finder/SubAttributes/Attrs.pm lib/Commandable/Invocation.pm lib/Commandable/Output.pm LICENSE MANIFEST This list of files META.json META.yml README t/00use.t t/01invocation.t t/10finder-packages-namemethod.t t/11finder-packages-namepkg.t t/12finder-subattributes.t t/13finder-methodattributes.t t/20command-args.t t/21command-opts.t t/30finder-invoke.t t/31finder-config.t t/32finder-global-opts.t t/50builtin-help.t t/99pod.t Commandable-0.14/META.json000444001750001750 422714667075260 14161 0ustar00leoleo000000000000{ "abstract" : "utilities for commandline-based programs", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4234", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Commandable", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.4004" } }, "runtime" : { "requires" : { "Module::Pluggable::Object" : "0", "experimental" : "0", "meta" : "0.003_003", "perl" : "5.026" } }, "test" : { "requires" : { "Test2::V0" : "0" } } }, "provides" : { "Commandable" : { "file" : "lib/Commandable.pm", "version" : "0.14" }, "Commandable::Command" : { "file" : "lib/Commandable/Command.pm", "version" : "0.14" }, "Commandable::Finder" : { "file" : "lib/Commandable/Finder.pm", "version" : "0.14" }, "Commandable::Finder::MethodAttributes" : { "file" : "lib/Commandable/Finder/MethodAttributes.pm", "version" : "0.14" }, "Commandable::Finder::Packages" : { "file" : "lib/Commandable/Finder/Packages.pm", "version" : "0.14" }, "Commandable::Finder::SubAttributes" : { "file" : "lib/Commandable/Finder/SubAttributes.pm", "version" : "0.14" }, "Commandable::Finder::SubAttributes::Attrs" : { "file" : "lib/Commandable/Finder/SubAttributes/Attrs.pm", "version" : "0.14" }, "Commandable::Invocation" : { "file" : "lib/Commandable/Invocation.pm", "version" : "0.14" }, "Commandable::Output" : { "file" : "lib/Commandable/Output.pm", "version" : "0.14" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.14", "x_serialization_backend" : "JSON::PP version 4.16" } Commandable-0.14/META.yml000444001750001750 270414667075260 14007 0ustar00leoleo000000000000--- abstract: 'utilities for commandline-based programs' author: - 'Paul Evans ' build_requires: Test2::V0: '0' configure_requires: Module::Build: '0.4004' dynamic_config: 1 generated_by: 'Module::Build version 0.4234, 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: Commandable provides: Commandable: file: lib/Commandable.pm version: '0.14' Commandable::Command: file: lib/Commandable/Command.pm version: '0.14' Commandable::Finder: file: lib/Commandable/Finder.pm version: '0.14' Commandable::Finder::MethodAttributes: file: lib/Commandable/Finder/MethodAttributes.pm version: '0.14' Commandable::Finder::Packages: file: lib/Commandable/Finder/Packages.pm version: '0.14' Commandable::Finder::SubAttributes: file: lib/Commandable/Finder/SubAttributes.pm version: '0.14' Commandable::Finder::SubAttributes::Attrs: file: lib/Commandable/Finder/SubAttributes/Attrs.pm version: '0.14' Commandable::Invocation: file: lib/Commandable/Invocation.pm version: '0.14' Commandable::Output: file: lib/Commandable/Output.pm version: '0.14' requires: Module::Pluggable::Object: '0' experimental: '0' meta: 0.003_003 perl: '5.026' resources: license: http://dev.perl.org/licenses/ version: '0.14' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Commandable-0.14/README000444001750001750 516314667075260 13420 0ustar00leoleo000000000000NAME Commandable - utilities for commandline-based programs DESCRIPTION This distribution contains a collection of utilities extracted from various commandline-based programs I have written, in the hope of trying to find a standard base to build these from in future. Note that "commandline" does not necessarily mean "plain-text running in a terminal"; simply that the mode of operation is that the user types a textual representation of some action, and the program parses this text in order to perform it. This could equally apply to a command input text area in a GUI program. PROGRAM STRUCTURE A typical program using this distribution would have a single instance of a "finder", whose job is to work out the set of commands offered by the program. Various subclasses of finder are provided that use different techniques to locate the individual commands, depending on the structure provided by the program. * Commandable::Finder::SubAttributes - expects to find each command implemented as a subroutine within a single package. These subroutines should all have attributes that provide description text, and specifications of argument and option parsing. The code body of the subroutine is then used to implement the actual command. * Commandable::Finder::MethodAttributes - a variant of the above which expects that commands are implemented as methods on an object instance. * Commandable::Finder::Packages - expects to find each command implemented as an entire package, with (constant) subroutines to give the description text and argument and option parsing specifications. Another subroutine within the package actually implements the command. As the user requests that commands be executed, the text of each request is then wrapped in an instance of Commandable::Invocation. This is then passed to the finder instance to actually invoke a command by parsing its name, options and arguments, and run the actual code body. my $finder = Commandable::Finder::...->new( ... ); my $cinv = Commandable::Invocation->new( $text ); $finder->find_and_invoke( $cinv ); The finder instance is not modified by individual invocations, and can be reused if the program wishes to provide some sort of multiple invocation ability; perhaps in the form of a REPL-like shell: my $finder = ... while( my $text = ) { $finder->find_and_invoke( Commandable::Invocation->new( $text ) ); } AUTHOR Paul Evans Commandable-0.14/lib000755001750001750 014667075260 13144 5ustar00leoleo000000000000Commandable-0.14/lib/Commandable.pm000444001750001750 540214667075260 16042 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2018-2023 -- leonerd@leonerd.org.uk package Commandable 0.14; use v5.14; use warnings; =head1 NAME C - utilities for commandline-based programs =head1 DESCRIPTION This distribution contains a collection of utilities extracted from various commandline-based programs I have written, in the hope of trying to find a standard base to build these from in future. Note that "commandline" does not necessarily mean "plain-text running in a terminal"; simply that the mode of operation is that the user types a textual representation of some action, and the program parses this text in order to perform it. This could equally apply to a command input text area in a GUI program. =head1 PROGRAM STRUCTURE A typical program using this distribution would have a single instance of a "finder", whose job is to work out the set of commands offered by the program. Various subclasses of finder are provided that use different techniques to locate the individual commands, depending on the structure provided by the program. =over 4 =item * L - expects to find each command implemented as a subroutine within a single package. These subroutines should all have attributes that provide description text, and specifications of argument and option parsing. The code body of the subroutine is then used to implement the actual command. =item * L - a variant of the above which expects that commands are implemented as methods on an object instance. =item * L - expects to find each command implemented as an entire package, with (constant) subroutines to give the description text and argument and option parsing specifications. Another subroutine within the package actually implements the command. =back As the user requests that commands be executed, the text of each request is then wrapped in an instance of L. This is then passed to the finder instance to actually invoke a command by parsing its name, options and arguments, and run the actual code body. my $finder = Commandable::Finder::...->new( ... ); my $cinv = Commandable::Invocation->new( $text ); $finder->find_and_invoke( $cinv ); The finder instance is not modified by individual invocations, and can be reused if the program wishes to provide some sort of multiple invocation ability; perhaps in the form of a REPL-like shell: my $finder = ... while( my $text = ) { $finder->find_and_invoke( Commandable::Invocation->new( $text ) ); } =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable000755001750001750 014667075260 15346 5ustar00leoleo000000000000Commandable-0.14/lib/Commandable/Command.pm000444001750001750 1356214667075260 17446 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2021-2024 -- leonerd@leonerd.org.uk package Commandable::Command 0.14; use v5.26; use warnings; use experimental qw( signatures ); =head1 NAME C - represent metadata for an invokable command =head1 DESCRIPTION Objects in this class are returned by a L instance to represent individual commands that exist. =cut sub new ( $class, %args ) { $args{arguments} //= []; $args{options} //= {}; bless [ @args{qw( name description arguments options package code )} ], $class; } =head1 ACCESSORS The following simple methods return metadata fields about the command =cut =head2 name =head2 description $name = $command->name; $desc = $command->description; Strings giving the short name (to be used on a commandline), and descriptive text for the command. =head2 arguments @args = $command->arguments; A (possibly-empty) list of argument metadata structures. =head2 options %opts = $command->options; A (possibly-empty) kvlist of option metadata structures. =head2 package $pkg = $command->package; The package name as a plain string. =head2 code $sub = $command->code; A CODE reference to the code actually implementing the command. =cut sub name { shift->[0] } sub description { shift->[1] } sub arguments { shift->[2]->@* } sub options { shift->[3]->%* } sub package { shift->[4] } sub code { shift->[5] } =head1 METHODS =cut =head2 parse_invocation I this method has been moved to L. =cut package # hide Commandable::Command::_Argument; =head1 ARGUMENT SPECIFICATIONS Each argument specification is given by an object having the following structure: =head2 name =head2 description $name = $argspec->name; $desc = $argspec->description; Text strings for the user, used to generate the help text. =head2 optional $bool = $argspec->optional; If false, the option is mandatory and an error is raised if no value is provided for it. If true, it is optional and if absent an C will passed instead. =head2 slurpy $bool = $argspec->slurpy; If true, the argument will be passed as an ARRAY reference containing the entire remaining list of tokens provided by the user. =cut sub new ( $class, %args ) { bless [ @args{qw( name description optional slurpy )} ], $class; } sub name { shift->[0] } sub description { shift->[1] } sub optional { shift->[2] } sub slurpy { shift->[3] } package # hide Commandable::Command::_Option; =head1 OPTION SPECIFICATIONS Each option specification is given by an object having the following structure: =head2 name $name = $optspec->name; A string giving the primary human-readable name of the option. =head2 keyname $keyname = $optspec->keyname; A string giving the name this option will be given in the options hash provided to the command subroutine. This is generated from the human-readable name, but hyphens are converted to underscores, to make it simpler to use as a hash key in Perl code. =head2 names @names = $optspec->names; A list containing the name plus all the aliases this option is known by. =head2 description $desc = $optspec->description; A text string containing information for the user, used to generate the help text. =head2 mode $mode = $optspec->mode; A string that describes the behaviour of the option. C options do not expect a value to be suppled by the user, and will store a true value in the options hash if present. C options take a value from the rest of the token, or the next token. --opt=value --opt value C options can be supplied more than once; values are pushed into an ARRAY reference which is passed in the options hash. C options may be supplied more than once; each occurance will increment the stored value by one. =head2 default $val = $optspec->default; A value to provide in the options hash if the user did not specify a different one. =head2 negatable $bool = $optspec->negatable; If true, also accept a C<--no-OPT> option to reset the value of the option to C. =head2 typespec I no longer supported. =head2 matches $re = $optspec->matches; If defined, gives a precompiled regexp that any user-supplied value must conform to. A few shortcuts are provided, which are used if the provided name ends in C<=i> (for "integer"), C<=u> (for "unsigned integer", i.e. non-negative) or C<=f> (for "float"). =cut my %typespecs = ( i => [ "be an integer", qr/^-?\d+$/ ], u => [ "be a non-negative integer", qr/^\d+$/ ], f => [ "be a floating-point number", qr/^-?\d+(?:\.\d+)?$/ ], ); sub new ( $class, %args ) { warn "Use of $args{name} in a Commandable command option name; should be " . $args{name} =~ s/:$/=/r if $args{name} =~ m/:$/; if( $args{name} =~ s/([=:])(.+?)$/$1/ ) { # Convert a type abbreviation my $typespec = $typespecs{$2} or die "Unrecognised typespec $2"; ( $args{match_msg}, $args{matches} ) = @$typespec; } $args{mode} = "value" if $args{name} =~ s/[=:]$//; $args{mode} = "multi_value" if $args{multi}; my @names = split m/\|/, delete $args{name}; $args{mode} //= "set"; $args{negatable} //= 1 if $args{mode} eq "bool"; bless [ \@names, @args{qw( description mode default negatable matches match_msg )} ], $class; } sub name { shift->[0]->[0] } sub keyname { shift->name =~ s/-/_/gr } sub names { shift->[0]->@* } sub description { shift->[1] } sub mode { shift->[2] } sub default { shift->[3] } sub negatable { shift->[4] } sub matches { shift->[5] } sub match_msg { shift->[6] } sub mode_expects_value { shift->mode =~ m/value$/ } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Finder.pm000444001750001750 3707014667075260 17277 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2021-2024 -- leonerd@leonerd.org.uk package Commandable::Finder 0.14; use v5.26; use warnings; use experimental qw( signatures ); use Carp; use List::Util 'max'; require Commandable::Output; =head1 NAME C - an interface for discovery of Ls =head1 SYNOPSIS use Commandable::Finder::...; my $finder = Commandable::Finder::...->new( ... ); $finder->find_and_invoke( Commandable::Invocation->new( $text ) ); =head1 DESCRIPTION This base class is common to the various finder subclasses: =over 4 =item * L =item * L =item * L =back =head1 METHODS =cut =head2 configure $finder = $finder->configure( %conf ); Sets configuration options on the finder instance. Returns the finder instance itself, to permit easy chaining. The following configuration options are recognised: =head3 allow_multiple_commands If enabled, the L method will permit multiple command invocations within a single call. =head3 require_order If enabled, stop processing options when the first non-option argument is seen. =head3 bundling If enabled, short (single-letter) options of simple boolean type can be combined into a single C<-abc...> argument. Incrementable options can be specified multiple times (as common with things like C<-vvv> for C<--verbose 3>). =cut sub configure ( $self, %conf ) { exists $conf{$_} and $self->{config}{$_} = delete $conf{$_} for qw( allow_multiple_commands require_order bundling ); keys %conf and croak "Unrecognised ->configure params: " . join( ", ", sort keys %conf ); return $self; } =head2 add_global_options $finder->add_global_options( @optspecs ); I Adds additional global options to the stored set. Each is specified as a HASH reference containing keys to specify one option, in the same style as the per-command options used by L. In addition, each should also provide a key named C, whose value should be a SCALAR or CODE reference to be used for applying the value for the option when it is parsed. SCALAR references will be assigned to directly; CODE references will be invoked with the option's name and value as positional arguments: $$into = $value; $into->( $name, $value ); This style permits a relatively easy upgrade from such modules as L, to handle global options. GetOptions( 'verbose|v+' => \my $VERBOSE, 'silent|s' => \my $SILENT, ) or exit 1; Can now become $finder->add_global_options( { name => "verbose|v", mode => "inc", into => \my $VERBOSE, description => "Increase verbosity of output" }, { name => "silent|s", into => \my $SILENT, description => "Silence output entirely" }, ); with the added benefit of automated integration with the global C command, more consistent option parsing along with other command handling, and so on. =cut sub add_global_options ( $self, @optspecs ) { foreach my $optspec ( @optspecs ) { my $into = $optspec->{into}; my $opt = Commandable::Command::_Option->new( %$optspec ); my $name = $opt->name; defined $into or croak "Global option $name requires an 'into'"; ( ref $into ) =~ m/^(?:SCALAR|CODE)$/ or croak "Global option $name 'into' must be a SCALAR or CODE reference; got "; $self->{global_options}{ $_ } = $opt for $opt->names; $self->{global_options_into}{ $opt->keyname } = $into; } return $self; } =head2 handle_global_options $finder->handle_global_options( $cinv ); I Extracts global options from the command invocation and process them into the C references previously supplied. Normally it would not be necessary to invoke this directly, because the main L method does this anyway. It is provided in case the implementing program performs its own command handling or changes the logic in some other way. =cut sub handle_global_options ( $self, $cinv ) { my $global_optspecs = $self->{global_options} or return; my $opts = $self->parse_invocation_options( $cinv, $global_optspecs, passthrough => 1 ); foreach ( keys %$opts ) { my $value = $opts->{$_}; my $into = $self->{global_options_into}{$_}; if( ref $into eq "SCALAR" ) { $into->$* = $value; } else { $into->( $_, $value ); } } } =head2 find_commands @commands = $finder->find_commands; Returns a list of command instances, in no particular order. Each will be an instance of L. =head2 find_command $command = $finder->find_command( $cmdname ); Returns a command instance of the given name as an instance of L, or C if there is none. =cut =head2 parse_invocation @vals = $finder->parse_invocation( $command, $cinv ); I Parses values out of a L instance according to the specification for the command's arguments. Returns a list of perl values suitable to pass into the function implementing the command. This method will throw an exception if mandatory arguments are missing. =cut sub parse_invocation ( $self, $command, $cinv ) { my @args; if( my %optspec = $command->options ) { push @args, $self->parse_invocation_options( $cinv, \%optspec ); } foreach my $argspec ( $command->arguments ) { my $val = $cinv->pull_token; if( defined $val ) { if( $argspec->slurpy ) { my @vals = ( $val ); while( defined( $val = $cinv->pull_token ) ) { push @vals, $val; } $val = \@vals; } push @args, $val; } elsif( !$argspec->optional ) { die "Expected a value for '".$argspec->name."' argument\n"; } else { # optional argument was missing; this is the end of the args last; } } return @args; } sub parse_invocation_options ( $self, $cinv, $optspec, %params ) { my $passthrough = $params{passthrough}; my $opts = {}; my @remaining; while( defined( my $token = $cinv->pull_token ) ) { if( $token eq "--" ) { push @remaining, $token if $passthrough; last; } my $spec; my $value_in_token; my $token_again; my $value = 1; my $orig = $token; if( $token =~ s/^--([^=]+)(=|$)// ) { my ( $opt, $equal ) = ($1, $2); if( !$optspec->{$opt} and $opt =~ /no-(.+)/ ) { $spec = $optspec->{$1} and $spec->negatable or die "Unrecognised option name --$opt\n"; $value = undef; } elsif( $spec = $optspec->{$opt} ) { $value_in_token = length $equal; } else { die "Unrecognised option name --$opt\n" unless $passthrough; push @remaining, $orig; next; } } elsif( $token =~ s/^-(.)// ) { unless( $spec = $optspec->{$1} ) { die "Unrecognised option name -$1\n" unless $passthrough; push @remaining, $orig; next; } if( $spec->mode_expects_value ) { $value_in_token = length $token; } elsif( $self->{config}{bundling} and length $token and length($1) == 1 ) { $token_again = "-$token"; undef $token; } } else { push @remaining, $token; if( $self->{config}{require_order} ) { last; } else { next; } } my $name = $spec->name; if( $spec->mode_expects_value ) { $value = $value_in_token ? $token : ( $cinv->pull_token // die "Expected value for option --$name\n" ); } else { die "Unexpected value for parameter $name\n" if $value_in_token or length $token; } if( defined( my $matches = $spec->matches ) ) { $value =~ $matches or die "Value for --$name option must " . $spec->match_msg . "\n"; } my $keyname = $spec->keyname; if( $spec->mode eq "multi_value" ) { push $opts->{$keyname}->@*, $value; } elsif( $spec->mode eq "inc" ) { $opts->{$keyname}++; } elsif( $spec->mode eq "bool" ) { $opts->{$keyname} = !!$value; } else { $opts->{$keyname} = $value; } $token = $token_again, redo if defined $token_again; } $cinv->putback_tokens( @remaining ); foreach my $spec ( values %$optspec ) { my $keyname = $spec->keyname; $opts->{$keyname} = $spec->default if defined $spec->default and !exists $opts->{$keyname}; } return $opts; } =head2 find_and_invoke $result = $finder->find_and_invoke( $cinv ); A convenient wrapper around the common steps of finding a command named after the initial token in a L, parsing arguments from it, and invoking the underlying implementation function. If the C configuration option is set, it will repeatedly attempt to parse a command name followed by arguments and options while the invocation string is non-empty. =cut sub find_and_invoke ( $self, $cinv ) { my $multiple = $self->{config}{allow_multiple_commands}; # global options come first $self->handle_global_options( $cinv ) if $self->{global_options}; my $result; { defined( my $cmdname = $cinv->pull_token ) or die "Expected a command name\n"; my $cmd = $self->find_command( $cmdname ) or die "Unrecognised command '$cmdname'"; my @args = $self->parse_invocation( $cmd, $cinv ); !$multiple and length $cinv->peek_remaining and die "Unrecognised extra input: " . $cinv->peek_remaining . "\n"; $result = $cmd->code->( @args ); # TODO configurable separator - ';' or '|' or whatever # currently blank redo if $multiple and length $cinv->peek_remaining; } return $result; } =head2 find_and_invoke_list $result = $finder->find_and_invoke_list( @tokens ); A further convenience around creating a L from the given list of values and using that to invoke a command. =cut sub find_and_invoke_list ( $self, @args ) { require Commandable::Invocation; return $self->find_and_invoke( Commandable::Invocation->new_from_tokens( @args ) ); } =head2 find_and_invoke_ARGV $result = $finder->find_and_invoke_ARGV(); A further convenience around creating a L from the C<@ARGV> array and using that to invoke a command. Often this allows an entire wrapper script to be created in a single line of code: exit Commandable::Finder::SOMESUBCLASS->new( ... ) ->find_and_invoke_ARGV(); =cut sub find_and_invoke_ARGV ( $self ) { $self->find_and_invoke_list( @ARGV ); } =head1 BUILTIN COMMANDS The following built-in commands are automatically provided. =cut sub add_builtin_commands ( $self, $commands ) { $commands->{help} = Commandable::Command->new( name => "help", description => "Display a list of available commands", arguments => [ Commandable::Command::_Argument->new( name => "cmd", description => "command name", optional => 1, ) ], code => sub { @_ ? return $self->builtin_command_helpcmd( @_ ) : return $self->builtin_command_helpsummary; }, ); } # TODO: some pretty output formatting maybe using S:T:Terminal? sub _print_table2 ( $sep, @rows ) { my $max_len = max map { length $_->[0] } @rows; Commandable::Output->printf( "%-*s%s%s\n", $max_len, $_->[0], $sep, $_->[1] ) for @rows; } # A join() that respects stringify overloading sub _join { my $sep = shift; my $ret = shift; $ret .= "$sep$_" for @_; return $ret; } =head2 help help help $commandname With no arguments, prints a summary table of known command names and their descriptive text. If any global options have been registered, these are described as well. With a command name argument, prints more descriptive text about that command, additionally detailing the arguments and options. The package that implements a particular command can provide more output by implementing a method called C, which will take as a single argument the name of the command being printed. It should make use of the various printing methods in L to generate whatever extra output it wishes. =cut sub _print_optspecs ( $optspecs ) { # @optspecs may contain duplicates; filter them my %primary_names = map { $_->name => 1 } values %$optspecs; my @optspecs = @$optspecs{ sort keys %primary_names }; my $first = 1; foreach my $optspec ( @optspecs ) { Commandable::Output->printf( "\n" ) unless $first; undef $first; my $default = $optspec->default; my $value = $optspec->mode eq "value" ? " " : ""; my $no = $optspec->negatable ? "[no-]" : ""; Commandable::Output->printf( " %s\n", _join( ", ", map { Commandable::Output->format_note( length $_ > 1 ? "--$no$_$value" : "-$_$value", 1 ) } $optspec->names ) ); Commandable::Output->printf( " %s%s\n", $optspec->description, ( defined $default ? " (default: $default)" : "" ), ); } } sub builtin_command_helpsummary ( $self ) { my @commands = sort { $a->name cmp $b->name } $self->find_commands; Commandable::Output->print_heading( "COMMANDS:" ); _print_table2 ": ", map { [ " " . Commandable::Output->format_note( $_->name ), $_->description ] } @commands; if( my $opts = $self->{global_options} ) { Commandable::Output->printf( "\n" ); Commandable::Output->print_heading( "GLOBAL OPTIONS:" ); _print_optspecs( $opts ); } } sub builtin_command_helpcmd ( $self, $cmdname ) { my $cmd = $self->find_command( $cmdname ) or die "Unrecognised command '$cmdname' - see 'help' for a list of commands\n"; my @argspecs = $cmd->arguments; my %optspecs = $cmd->options; Commandable::Output->printf( "%s - %s\n", Commandable::Output->format_note( $cmd->name ), $cmd->description ); Commandable::Output->printf( "\n" ); Commandable::Output->print_heading( "SYNOPSIS:" ); Commandable::Output->printf( " %s\n", join " ", $cmd->name, %optspecs ? "[OPTIONS...]" : (), @argspecs ? ( map { my $argspec = $_; my $str = "\$" . uc $argspec->name; $str .= "..." if $argspec->slurpy; $str = "($str)" if $argspec->optional; $str; } @argspecs ) : () ); if( %optspecs ) { Commandable::Output->printf( "\n" ); Commandable::Output->print_heading( "OPTIONS:" ); _print_optspecs( \%optspecs ); } if( @argspecs ) { Commandable::Output->printf( "\n" ); Commandable::Output->print_heading( "ARGUMENTS:" ); _print_table2 " ", map { [ " " . Commandable::Output->format_note( '$' . uc $_->name, 1 ), $_->description ] } @argspecs; } my $cmdpkg = $cmd->package; if( $cmdpkg->can( "commandable_more_help" ) ) { $cmdpkg->commandable_more_help( $cmdname ); } return 0; } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Invocation.pm000444001750001750 1004714667075260 20174 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2018-2024 -- leonerd@leonerd.org.uk package Commandable::Invocation 0.14; use v5.26; use warnings; use experimental qw( signatures ); =head1 NAME C - represents one invocation of a CLI command =head1 SYNOPSIS my %commands = ( exit => sub { exit }, print => sub { print $_[0]->peek_remaining }, ... ); while(1) { my $inv = Commmandable::Invocation->new( scalar ); $commands{ $inv->pull_token }->( $inv ); } =head1 DESCRIPTION Instances of this class represent the text of a single invocation of a CLI command, allowing it to be incrementally parsed and broken into individual tokens during dispatch and invocation. =head2 Tokens When parsing for the next token, strings quoted using quote marks (C<"">) will be retained as a single token. Otherwise, tokens are split on (non-preserved) whitespace. Quote marks and backslashes may be escaped using C<\> characters. =cut =head1 CONSTRUCTOR =cut =head2 new $inv = Commandable::Invocation->new( $text ) Constructs a new instance, initialised to contain the given text string. =cut sub new ( $class, $text ) { $text =~ s/^\s+//; return bless { text => $text, }, $class; } =head2 new_from_tokens $inv = Commandable::Invocation->new_from_tokens( @tokens ) I Constructs a new instance, initialised to contain text from the given tokens, such that subsequent calls to L will yield the given list of tokens. This may be handy for constructing instances from C<@ARGV> or similar cases where text has already been parsed and split into tokens. =cut sub new_from_tokens ( $class, @tokens ) { my $self = $class->new( "" ); $self->putback_tokens( @tokens ); return $self; } =head1 METHODS =cut sub _next_token ( $self ) { if( $self->{text} =~ m/^"/ ) { $self->{text} =~ m/^"((?:\\.|[^"])*)"\s*/ and $self->{trim_pos} = $+[0], return $self->_unescape( $1 ); } else { $self->{text} =~ m/^(\S+)\s*/ and $self->{trim_pos} = $+[0], return $self->_unescape( $1 ); } return undef; } sub _escape ( $self, $s ) { return $s =~ s/(["\\])/\\$1/gr; } sub _unescape ( $self, $s ) { return $s =~ s/\\(["\\])/$1/gr; } =head2 peek_token $token = $inv->peek_token; Looks at, but does not remove, the next token in the text string. Subsequent calls to this method will yield the same string, as will the next call to L. =cut sub peek_token ( $self ) { return $self->{next_token} //= $self->_next_token; } =head2 pull_token $token = $inv->pull_token; Removes the next token from the text string and returns it. =cut sub pull_token ( $self ) { my $token = $self->{next_token} //= $self->_next_token; substr $self->{text}, 0, $self->{trim_pos}, "" if defined $token; undef $self->{next_token}; return $token; } =head2 peek_remaining $text = $inv->peek_remaining; I Returns the entire unparsed content of the rest of the text string. =cut sub peek_remaining ( $self ) { return $self->{text}; } =head2 putback_tokens $inv->putback_tokens( @tokens ); I Prepends text back onto the stored text string such that subsequent calls to L will yield the given list of tokens once more. This takes care to quote tokens with spaces inside, and escape any embedded backslashes or quote marks. This method is intended to be used, for example, around a commandline option parser which handles mixed options and arguments, to put back the non-option positional arguments after the options have been parsed and removed from it. =cut sub putback_tokens ( $self, @tokens ) { $self->{text} = join " ", ( map { my $s = $self->_escape( $_ ); $s =~ m/ / ? qq("$s") : $s } @tokens ), ( length $self->{text} ? $self->{text} : () ); } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Output.pm000444001750001750 1235114667075260 17363 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2022-2024 -- leonerd@leonerd.org.uk package Commandable::Output 0.14; use v5.26; use warnings; use experimental qw( signatures ); use constant HAVE_STRING_TAGGED => defined eval { require String::Tagged; require Convert::Color; }; use constant HAVE_STRING_TAGGED_TERMINAL => defined eval { require String::Tagged::Terminal; }; =head1 NAME C - abstractions for printing output from commands =head1 DESCRIPTION This package contains default implementations of methods for providing printed output from commands implemented using L. These methods are provided for the convenience of user code, and are also used by built-in commands provided by the C system itself. Implementations are permitted (encouraged, even) to replace any of these methods in order to customise their behaviour. =head2 WITH C If L and L are available, this module applies formatting to strings by using the L conventions. The C and C methods will return results as instances of C, suitable to pass into the main C method. =cut =head1 METHODS =cut sub _format_string ( $self, $text, $tagmethod ) { return $text unless HAVE_STRING_TAGGED; my %tags; %tags = $self->$tagmethod if $self->can( $tagmethod ); if( $tags{fg} and !ref $tags{fg} ) { $tags{fg} = Convert::Color->new( $tags{fg} ); } return String::Tagged->new_tagged( $text, %tags ); } =head2 printf Commandable::Output->printf( $format, @args ); The main output method, used to send messages for display to the user. The arguments are formatted into a single string by Perl's C function. This method does not append a linefeed. To output a complete line of text, remember to include the C<"\n"> at the end of the format string. The default implementation writes output on the terminal via STDOUT. In cases where the output should be sent to some other place (perhaps a GUI display widget of some kind), the application should replace this method with something that writes the display to somewhere more appropriate. Don't forget to use C to format the arguments into a string. no warnings 'redefine'; sub Commandable::Output::printf { shift; # the package name my ( $format, @args ) = @_; my $str = sprintf $format, @args; $gui_display_widget->append_text( $str ); } If L is available, the output will be printed using this module, by first converting the format string and arguments using L and then constructing a terminal string using L. This means the default implementation will be able to output formatted strings using the L conventions. =cut sub printf ( $self, $format, @args ) { if( HAVE_STRING_TAGGED_TERMINAL ) { String::Tagged::Terminal->new_from_formatting( String::Tagged->from_sprintf( $format, @args ) )->print_to_terminal; return; } printf $format, @args; } =head2 print_heading Commandable::Output->print_heading( $text, $level ); Used to send output that should be considered like a section heading. I<$level> may be an integer used to express sub-levels; increasing values from 1 upwards indicate increasing sub-levels. The default implementation formats the text string using L then prints it using L with a trailing linefeed. =cut sub print_heading ( $self, $text, $level = 1 ) { $self->printf( "%s\n", $self->format_heading( $text, $level ) ); } =head2 format_heading $str = Commandable::Output->format_heading( $text, $level ); Returns a value for printing, to represent a section heading for the given text and level. The default implementation applies the following formatting if C is available: =over 4 =item Level 1 Underlined =item Level 2 Underlined, cyan colour =item Level 3 Bold =back =cut use constant TAGS_FOR_HEADING_1 => ( under => 1 ); use constant TAGS_FOR_HEADING_2 => ( under => 1, fg => "vga:cyan", ); use constant TAGS_FOR_HEADING_3 => ( bold => 1 ); sub format_heading ( $self, $text, $level = 1 ) { return $self->_format_string( $text, "TAGS_FOR_HEADING_$level" ); } =head2 format_note $str = Commandable::Output->format_note( $text, $level ); Returns a value for printing, to somehow highlight the given text (which should be a short word or string) at the given level. The default implementation applies the following formatting if C is available: =over 4 =item Level 0 Bold, yellow colour =item Level 1 Bold, cyan colour =item Level 2 Bold, magenta colour =back =cut use constant TAGS_FOR_NOTE_0 => ( bold => 1, fg => "vga:yellow" ); use constant TAGS_FOR_NOTE_1 => ( bold => 1, fg => "vga:cyan" ); use constant TAGS_FOR_NOTE_2 => ( bold => 1, fg => "vga:magenta" ); sub format_note ( $self, $text, $level = 0 ) { return $self->_format_string( $text, "TAGS_FOR_NOTE_$level" ); } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Finder000755001750001750 014667075260 16555 5ustar00leoleo000000000000Commandable-0.14/lib/Commandable/Finder/MethodAttributes.pm000444001750001750 416214667075260 22542 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2022-2024 -- leonerd@leonerd.org.uk package Commandable::Finder::MethodAttributes 0.14; use v5.14; use warnings; use experimental qw( signatures ); use base qw( Commandable::Finder::SubAttributes ); use Carp; =head1 NAME C - find commands stored as methods with attributes =head1 SYNOPSIS use Commandable::Finder::MethodAttributes; my $object = SomeClass->new( ... ); my $finder = Commandable::Finder::MethodAttributes->new( object => $object, ); my $help_command = $finder->find_command( "help" ); foreach my $command ( $finder->find_commands ) { ... } =head1 DESCRIPTION This subclass of L looks for methods that define commands, where each command is provided by an individual method in a given class. It stores the object instance and arranges that each discovered command method will capture it, passing it as the first argument when invoked. The attributes on each method are those given by C and are used in the same way here. =cut =head1 CONSTRUCTOR =cut =head2 new $finder = Commandable::Finder::MethodAttributes->new( %args ) Constructs a new instance of C. Takes the following named arguments: =over 4 =item object => OBJ An object reference. Its class will be used for searching for command methods. The instance itself is stored by the finder object and used to wrap each command method. =back Any additional arguments are passed to the superclass constructor. =cut sub new ( $class, %args ) { my $object = delete $args{object} or croak "Require 'object'"; $args{package} = ref $object; my $self = $class->SUPER::new( %args ); $self->{object} = $object; return $self; } sub _wrap_code ( $self, $code ) { my $object = $self->{object}; return sub { $object->$code( @_ ); }; } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Finder/Packages.pm000444001750001750 1544014667075260 21012 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2019-2024 -- leonerd@leonerd.org.uk package Commandable::Finder::Packages 0.14; use v5.26; use warnings; use experimental qw( signatures ); use base qw( Commandable::Finder ); use Carp; use Commandable::Command; use Module::Pluggable::Object; =head1 NAME C - find commands stored per package =head1 SYNOPSIS use Commandable::Finder::Packages; my $finder = Commandable::Finder::Packages->new( base => "MyApp::Command", ); my $help_command = $finder->find_command( "help" ); foreach my $command ( $finder->find_commands ) { ... } =head1 DESCRIPTION This implementation of L looks for implementations of commands, where each command is implemented by a different package somewhere in the symbol table. This class uses L to load packages from the filesystem. As commands are located per package (and not per file), the application can provide special-purpose internal commands by implementing more packages in the given namespace, regardless of which files they come from. =head1 CONSTANTS package My::App::Commands::example; use constant COMMAND_NAME => "example"; use constant COMMAND_DESC => "an example of a command"; ... Properties about each command are stored as methods (usually constant methods) within each package. Often the L pragma module is used to create them. The following constant names are used by default: =head2 COMMAND_NAME use constant COMMAND_NAME => "name"; Gives a string name for the command. =head2 COMMAND_DESC use constant COMMAND_DESC => "description"; Gives a string description for the command. =head2 COMMAND_ARGS use constant COMMAND_ARGS => ( { name => "argname", description => "description" }, ); Gives a list of command argument specifications. Each specification is a HASH reference corresponding to one positional argument, and should contain keys named C, C, and optionally C. =head2 COMMAND_OPTS use constant COMMAND_OPTS => ( { name => "optname", description => "description" }, ); Gives a list of command option specifications. Each specification is a HASH reference giving one named option, in no particular order, and should contain keys named C, C and optionally C, C and C. =cut =head1 CONSTRUCTOR =cut =head2 new $finder = Commandable::Finder::Packages->new( %args ) Constructs a new instance of C. Takes the following named arguments: =over 4 =item base => STR The base of the package namespace to look inside for packages that implement commands. =item name_method => STR Optional. Gives the name of the method inside each command package to invoke to generate the name of the command. Default C. =item description_method => STR Optional. Gives the name of the method inside each command package to invoke to generate the description text of the command. Default C. =item arguments_method => STR Optional. Gives the name of the method inside each command package to invoke to generate a list of argument specifications. Default C. =item options_method => STR Optional. Gives the name of the method inside each command package to invoke to generate a list of option specifications. Default C. =item code_method => STR Optional. Gives the name of the method inside each command package which implements the actual command behaviour. Default C. =item named_by_package => BOOL Optional. If true, the name of each command will be taken from its package name. with the leading C string removed. If absent or false, the C will be used instead. =back If either name or description method are missing from a package, that package is silently ignored. Any additional arguments are passed to the C method to be used as configuration options. =cut sub new ( $class, %args ) { my $base = ( delete $args{base} ) or croak "Require 'base'"; my $name_method = ( delete $args{name_method} ) // "COMMAND_NAME"; my $description_method = ( delete $args{description_method} ) // "COMMAND_DESC"; my $arguments_method = ( delete $args{arguments_method} ) // "COMMAND_ARGS"; my $options_method = ( delete $args{options_method} ) // "COMMAND_OPTS"; my $code_method = ( delete $args{code_method} ) // "run"; # App-csvtool undef $name_method if delete $args{named_by_package}; my $mp = Module::Pluggable::Object->new( search_path => $base, require => 1, ); my $self = bless { mp => $mp, base => $base, methods => { name => $name_method, desc => $description_method, args => $arguments_method, opts => $options_method, code => $code_method, }, }, $class; $self->configure( %args ) if %args; return $self; } sub packages ( $self ) { my $name_method = $self->{methods}{name}; my $packages = $self->{cache_packages} //= [ $self->{mp}->plugins ]; return @$packages; } sub _commands ( $self ) { my $name_method = $self->{methods}{name}; return $self->{cache_commands} //= do { my %commands; foreach my $pkg ( $self->packages ) { next if defined $name_method and not $pkg->can( $name_method ); my $name = defined $name_method ? $pkg->$name_method : ( $pkg =~ s/\Q$self->{base}\E:://r ); my $code = $pkg->can( $self->{methods}{code} ) or next; my $desc = ( $pkg->can( $self->{methods}{desc} ) or next )->( $pkg ); my $args; if( my $argsmeth = $pkg->can( $self->{methods}{args} ) ) { $args = [ map { Commandable::Command::_Argument->new( %$_ ) } $pkg->$argsmeth ]; } my $opts; if( my $optsmeth = $pkg->can( $self->{methods}{opts} ) ) { $opts = { map { my $o = Commandable::Command::_Option->new( %$_ ); map { ( $_ => $o ) } $o->names } $pkg->$optsmeth }; } $commands{ $name } = Commandable::Command->new( name => $name, description => $desc, arguments => $args, options => $opts, package => $pkg, code => $code, ); } $self->add_builtin_commands( \%commands ); \%commands; }; } sub find_commands ( $self ) { return values $self->_commands->%*; } sub find_command ( $self, $cmd ) { return $self->_commands->{$cmd}; } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Finder/SubAttributes.pm000444001750001750 2153314667075260 22074 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2021-2024 -- leonerd@leonerd.org.uk package Commandable::Finder::SubAttributes 0.14; use v5.26; use warnings; use experimental qw( signatures ); use base qw( Commandable::Finder ); use Carp; use Commandable::Command; use constant HAVE_ATTRIBUTE_STORAGE => eval { require Attribute::Storage; Attribute::Storage->VERSION( '0.12' ); }; =head1 NAME C - find commands stored as subs with attributes =head1 SYNOPSIS use Commandable::Finder::SubAttributes; my $finder = Commandable::Finder::SubAttributes->new( package => "MyApp::Commands", ); my $help_command = $finder->find_command( "help" ); foreach my $command ( $finder->find_commands ) { ... } =head1 DESCRIPTION This implementation of L looks for functions that define commands, where each command is provided by an individual sub in a given package. =head1 ATTRIBUTES use Commandable::Finder::SubAttributes ':attrs'; sub command_example :Command_description("An example of a command") { ... } Properties about each command are stored as attributes on the named function, using L. The following attributes are available on the calling package when imported with the C<:attrs> symbol: =head2 Command_description :Command_description("description text") Gives a plain string description text for the command. =head2 Command_arg :Command_arg("argname", "description") Gives a named argument for the command and its description. If the name is suffixed by a C, this argument is optional. (The C itself will be removed from the name). If the name is suffixed by C<...>, this argument is slurpy. (The C<...> itself will be removed from the name). =head2 Command_opt :Command_opt("optname", "description") :Command_opt("optname", "description", "default") Gives a named option for the command and its description. If the name contains C<|> characters it provides multiple name aliases for the same option. If the name field ends in a C<=> character, a value is expected for the option. It can either be parsed from the next input token, or after an C<=> sign of the same token: --optname VALUE --optname=VALUE If the name field ends in a C<@> character, a value is expected for the option and can be specified multiple times. All the values will be collected into an ARRAY reference. If the name field ends in a C<+> character, the option can be specified multiple times and the total count will be used as the value. If the name field ends in a C character, the option is negatable. An option name of C<--no-OPTNAME> is recognised and will reset the value to C. By setting a default of some true value (e.g. C<1>) you can detect if this has happened. An optional third argument may be present to specify a default value, if not provided by the invocation. =head1 GLOBAL OPTION ATTRIBUTES I this module also allows attaching attributes to package variables in the package that stores the subroutines (often C
), which will then be handled automatically as global options by the finder. Remember that these have to be I variables (i.e. declared with C); lexical variables (declared with C) will not work. our $VERBOSE :GlobalOption("verbose|v+", "Increase the verbosity of status output"); This often serves as a convenient alternative to modules like L, because it integrates with the C command automatically. =head2 GlobalOption :GlobalOption("optname", "description") Gives the name for this global option and its description. These are handled in the same way as for L given above, except that no default is handled here. Instead, if the variable already has a value that will be taken as its default. =cut sub import ( $pkg, @syms ) { my $caller = caller; foreach ( @syms ) { if( $_ eq ":attrs" ) { HAVE_ATTRIBUTE_STORAGE or croak "Cannot import :attrs as Attribute::Storage is not available"; require Commandable::Finder::SubAttributes::Attrs; Commandable::Finder::SubAttributes::Attrs->import_into( $caller ); next; } croak "Unrecognised import symbol $_"; } } =head1 CONSTRUCTOR =cut =head2 new $finder = Commandable::Finder::SubAttributes->new( %args ) Constructs a new instance of C. Takes the following named arguments: =over 4 =item package => STR The name of the package to look in for command subs. =item name_prefix => STR Optional. Gives the name prefix to use to filter for subs that actually provide a command, and to strip off to find the name of the command. Default C. =item underscore_to_hyphen => BOOL Optional. If true, sub names that contain underscores will be converted into hyphens. This is often useful in CLI systems, allowing commands to be typed with hyphenated names (e.g. "get-thing") while the Perl sub that implements it is named with an underscores (e.g. "command_get_thing"). Defaults true, but can be disabled by passing a defined-but-false value such as C<0> or C<''>. =back Any additional arguments are passed to the C method to be used as configuration options. =cut sub new ( $class, %args ) { HAVE_ATTRIBUTE_STORAGE or croak "Cannot create a $class as Attribute::Storage is not available"; my $package = ( delete $args{package} ) or croak "Require 'package'"; my $name_prefix = ( delete $args{name_prefix} ) // "command_"; my $conv_under = ( delete $args{underscore_to_hyphen} ) // 1; my $self = bless { package => $package, name_prefix => $name_prefix, conv_under => $conv_under, }, $class; $self->configure( %args ) if %args; # TODO: This package name should probably be separately configurable if( my %global_opts = Attribute::Storage::find_vars_with_attr( $package, "GlobalOption" ) ) { foreach my $varname ( sort keys %global_opts ) { my $varref = $global_opts{$varname}; my $optspec = Attribute::Storage::get_varattr( $varref, "GlobalOption" ); my ( $name, $description ) = @$optspec; my %optspec = ( name => $name, description => $description, into => $varref, ); $optspec{default} = $$varref if defined $$varref; $self->add_global_options( \%optspec ); } } return $self; } =head2 new_for_caller =head2 new_for_main $finder = Commandable::Finder::SubAttributes->new_for_caller( %args ) $finder = Commandable::Finder::SubAttributes->new_for_main( %args ) Convenient wrapper constructors that pass either the caller's package name or C
as the package name. Combined with the C method these are particularly convenient for wrapper scripts: #!/usr/bin/perl use v5.14; use warnings; use Commandable::Finder::SubAttributes ':attrs'; exit Commandable::Finder::SubAttributes->new_for_main ->find_and_invoke_ARGV; # command subs go here... =cut sub new_for_caller ( $class, @args ) { return $class->new( package => scalar caller, @args ); } sub new_for_main ( $class, @args ) { return $class->new( package => "main", @args ); } sub _wrap_code ( $self, $code ) { return $code; } sub _commands ( $self ) { my $prefix = qr/$self->{name_prefix}/; my %subs = Attribute::Storage::find_subs_with_attr( $self->{package}, "Command_description", matching => qr/^$prefix/, ); my %commands; foreach my $subname ( keys %subs ) { my $code = $subs{$subname}; my $name = $subname =~ s/^$prefix//r; $name =~ s/_/-/g if $self->{conv_under}; my $args; if( $args = Attribute::Storage::get_subattr( $code, "Command_arg" ) ) { $args = [ map { Commandable::Command::_Argument->new( %$_ ) } @$args ]; } my $opts; if( $opts = Attribute::Storage::get_subattr( $code, "Command_opt" ) ) { $opts = { map { my $o = Commandable::Command::_Option->new( %$_ ); map { ( $_ => $o ) } $o->names } @$opts }; } $commands{ $name } = Commandable::Command->new( name => $name, description => Attribute::Storage::get_subattr( $code, "Command_description" ), arguments => $args, options => $opts, package => $self->{package}, code => $self->_wrap_code( $code ), ); } $self->add_builtin_commands( \%commands ); return \%commands; } sub find_commands ( $self ) { return values $self->_commands->%*; } sub find_command ( $self, $cmd ) { return $self->_commands->{$cmd}; } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/lib/Commandable/Finder/SubAttributes000755001750001750 014667075260 21355 5ustar00leoleo000000000000Commandable-0.14/lib/Commandable/Finder/SubAttributes/Attrs.pm000444001750001750 461214667075260 23150 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2021-2024 -- leonerd@leonerd.org.uk package Commandable::Finder::SubAttributes::Attrs 0.14; use v5.26; use warnings; # We can't use 'signatures' feature here because the order of attributes vs. # signature changed in perl 5.28. The syntax we want to use only works on 5.28 # onwards but it would be nice to still support 5.26 for a while longer. use Carp; use meta 0.003_003; no warnings qw( meta::experimental ); use Attribute::Storage 0.12; =head1 NAME C - subroutine attribute definitions for C =head1 DESCRIPTION This module contains the attribute definitions to apply to subroutines when using L. It should not be used directly. =cut sub import_into { my ( $pkg, $caller ) = @_; # Importing these lexically is a bit of a mess. my $callermeta = meta::package->get( $caller ); $callermeta->add_symbol( '&MODIFY_CODE_ATTRIBUTES' => \&MODIFY_CODE_ATTRIBUTES ); push $callermeta->get_or_add_symbol( '@ISA' )->reference->@*, __PACKAGE__; } sub Command_description :ATTR(CODE) { my ( $class, $text ) = @_; return $text; } sub Command_arg :ATTR(CODE,MULTI) { my ( $class, $args, $name, $description ) = @_; my $optional = $name =~ s/\?$//; my $slurpy = $name =~ s/\.\.\.$//; my %arg = ( name => $name, description => $description, optional => $optional, slurpy => $slurpy, # TODO: all sorts involving type, etc... ); push @$args, \%arg; return $args; } sub Command_opt :ATTR(CODE,MULTI) { my ( $class, $opts, $name, $description, $default ) = @_; my $mode = "set"; $mode = "value" if $name =~ s/=$//; $mode = "inc" if $name =~ s/\+$//; my $negatable = $name =~ s/\!$//; my $multi = $name =~ s/\@$//; my %optspec = ( name => $name, description => $description, mode => $mode, multi => $multi, negatable => $negatable, default => $default, ); push @$opts, \%optspec; return $opts; } sub GlobalOption :ATTR(SCALAR) { my ( $class, $name, $description ) = @_; return [ $name, $description ]; } =head1 AUTHOR Paul Evans =cut 0x55AA; Commandable-0.14/t000755001750001750 014667075260 12641 5ustar00leoleo000000000000Commandable-0.14/t/00use.t000444001750001750 43314667075260 14077 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; require Commandable; require Commandable::Command; require Commandable::Finder::MethodAttributes; require Commandable::Finder::Packages; require Commandable::Finder::SubAttributes; pass( "Modules loaded" ); done_testing; Commandable-0.14/t/01invocation.t000444001750001750 543714667075260 15506 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Invocation; my $warnings = ""; $SIG{__WARN__} = sub { local $SIG{__WARN__}; $warnings .= join "", @_; warn @_; }; # tokens { my $inv = Commandable::Invocation->new( "some words go here" ); is( $inv->peek_token, "some", '->peek_token' ); is( $inv->pull_token, "some", '->pull_token' ); is( $inv->pull_token, "words", '->pull_token again' ); is( $inv->pull_token, "go", '->pull_token again' ); is( $inv->pull_token, "here", '->pull_token again' ); is( $inv->peek_token, undef, '->peek_token at EOF' ); is( $inv->pull_token, undef, '->pull_token at EOF' ); } # peek_remaining { my $inv = Commandable::Invocation->new( "more tokens here" ); is( $inv->peek_remaining, "more tokens here", '->peek_remaining initially' ); $inv->pull_token; is( $inv->peek_remaining, "tokens here", '->peek_remaining after ->pull_token' ); } # "quoted tokens" { my $inv = Commandable::Invocation->new( q("quoted token" here) ); is( $inv->peek_remaining, q("quoted token" here), '->peek_remaining initially' ); is( $inv->pull_token, "quoted token", '->pull_token yields string' ); is( $inv->peek_remaining, "here", '->peek_remaining after ->pull_token' ); $inv = Commandable::Invocation->new( q("three" "quoted" "tokens") ); is( $inv->pull_token, "three", '->pull_token splits multiple quotes' ); } # \" escaping { my $inv = Commandable::Invocation->new( q(\"quoted\" string token) ); is( $inv->pull_token, '"quoted"', '->pull_token yields de-escaped quote' ); is( $inv->pull_token, 'string', '->pull_token after de-escaped quote' ); $inv = Commandable::Invocation->new( q(\\\\backslash) ); is( $inv->pull_token, "\\backslash", '->pull_token yields de-escaped backslash' ); } # putback { my $inv = Commandable::Invocation->new( "c" ); $inv->putback_tokens( qw( a b ), q("quoted string") ); is( $inv->peek_token, "a", '->peek_token after putback' ); is( $inv->pull_token, "a", '->pull_token after putback' ); is( $inv->pull_token, "b", '->pull_token after putback' ); is( $inv->pull_token, '"quoted string"', '->pull_token after putback' ); is( $inv->pull_token, "c", '->pull_token after putback' ); $inv->putback_tokens( "foo", "bar splot", '"quoted string"' ); is( $inv->peek_remaining, q(foo "bar splot" "\"quoted string\""), '->peek_remaining after putback' ); } # new_from_tokens { my $inv = Commandable::Invocation->new_from_tokens( "one", "two", "three four" ); is( $inv->pull_token, "one", '->pull_token from new_from_tokens' ); is( $inv->pull_token, "two", '->pull_token from new_from_tokens' ); is( $inv->pull_token, "three four", '->pull_token from new_from_tokens' ); } is( $warnings, "", 'had no warnings' ); done_testing; Commandable-0.14/t/10finder-packages-namemethod.t000444001750001750 402014667075260 20462 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::Packages; package MyTest::Command::one { use constant COMMAND_NAME => "one"; use constant COMMAND_DESC => "the one command"; use constant COMMAND_ARGS => ( { name => "arg", description => "the argument" } ); sub run {} } package MyTest::Command::two { use constant COMMAND_NAME => "two"; use constant COMMAND_DESC => "the two command"; use constant COMMAND_OPTS => ( { name => "simple" }, { name => "bool", mode => "bool" }, { name => "multi", multi => 1 }, ); sub run {} } package MyTest::Command::nothing { sub foo {} # not a command } my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", ); # find_commands { is( [ sort map { $_->name } $finder->find_commands ], [qw( help one two )], '$finder->find_commands' ); } # a single command { my $one = $finder->find_command( "one" ); is( { map { $_, $one->$_ } qw( name description package ) }, { name => "one", description => "the one command", package => "MyTest::Command::one", }, '$finder->find_command' ); is( scalar $one->arguments, 1, '$one has an argument' ); my ( $arg ) = $one->arguments; is( { map { $_ => $arg->$_ } qw( name description ) }, { name => "arg", description => "the argument", }, 'metadata of argument to one' ); is( $one->package, "MyTest::Command::one", '$one->package' ); is( $one->code, \&MyTest::Command::one::run, '$one->code' ); } # command options { my $two = $finder->find_command( "two" ); my %opts = $two->options; is( { map { my $opt = $opts{$_}; $_ => { map { $_ => $opt->$_ } qw( mode negatable ) } } keys %opts }, { simple => { mode => "set", negatable => F() }, bool => { mode => "bool", negatable => T() }, multi => { mode => "multi_value", negatable => F() }, }, 'metadata of options to two' ); } done_testing; Commandable-0.14/t/11finder-packages-namepkg.t000444001750001750 154214667075260 17772 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::Packages; package MyTest::Command::one { use constant COMMAND_DESC => "the one command"; sub run {} } package MyTest::Command::two { use constant COMMAND_DESC => "the two command"; sub run {} } package MyTest::Command::nothing { sub foo {} # not a command } { my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", named_by_package => 1, ); is( [ sort map { $_->name } $finder->find_commands ], [qw( help one two )], '$finder->find_commands' ); my $one = $finder->find_command( "one" ); is( { map { $_, $one->$_ } qw( name description package ) }, { name => "one", description => "the one command", package => "MyTest::Command::one", }, '$finder->find_command' ); } done_testing; Commandable-0.14/t/12finder-subattributes.t000444001750001750 473014667075260 17477 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Invocation; use Commandable::Finder::SubAttributes; BEGIN { Commandable::Finder::SubAttributes::HAVE_ATTRIBUTE_STORAGE or plan skip_all => "Attribute::Storage is not available"; } package MyTest::Commands { use Commandable::Finder::SubAttributes ':attrs'; our $globalopt :GlobalOption("global="); sub command_one :Command_description("the one command") :Command_arg("arg", "the argument") { # command } sub command_two :Command_description("the two command") :Command_opt("simple") :Command_opt("bool!") :Command_opt("multi@") { # command } sub command_with_hyphen :Command_description("command with hyphenated name") { # command } } my $finder = Commandable::Finder::SubAttributes->new( package => "MyTest::Commands", ); # find_commands { is( [ sort map { $_->name } $finder->find_commands ], [qw( help one two with-hyphen )], '$finder->find_commmands' ); } # a single command { my $one = $finder->find_command( "one" ); is( { map { $_, $one->$_ } qw( name description package code ) }, { name => "one", description => "the one command", package => "MyTest::Commands", code => \&MyTest::Commands::command_one, }, '$finder->find_command' ); is( scalar $one->arguments, 1, '$one has an argument' ); my ( $arg ) = $one->arguments; is( { map { $_ => $arg->$_ } qw( name description ) }, { name => "arg", description => "the argument", }, 'metadata of argument to one' ); } # command options { my $two = $finder->find_command( "two" ); my %opts = $two->options; is( { map { my $opt = $opts{$_}; $_ => { map { $_ => $opt->$_ } qw( mode negatable ) } } keys %opts }, { simple => { mode => "set", negatable => F() }, bool => { mode => "set", negatable => T() }, multi => { mode => "multi_value", negatable => F() }, }, 'metadata of options to two' ); } # global options { # TODO: we don't really have a way to query about these, so we'll just # have to invoke them to observe side-effects $finder->handle_global_options( Commandable::Invocation->new( "--global=1234" ) ); is( $MyTest::Commands::globalopt, 1234, '->handle_global_options set the value of $globalopt' ); } done_testing; Commandable-0.14/t/13finder-methodattributes.t000444001750001750 306614667075260 20170 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::MethodAttributes; BEGIN { Commandable::Finder::SubAttributes::HAVE_ATTRIBUTE_STORAGE or plan skip_all => "Attribute::Storage is not available"; } my @called; package MyTest::Commands { use Commandable::Finder::MethodAttributes ':attrs'; sub command_one :Command_description("the one command") :Command_arg("arg", "the argument") { my $self = shift; my ( $arg ) = @_; push @called, { self => $self, arg => $arg }; } } my $finder = Commandable::Finder::MethodAttributes->new( object => my $object = bless {}, "MyTest::Commands", ); # find_commands { is( [ sort map { $_->name } $finder->find_commands ], [qw( help one )], '$finder->find_commmands' ); } # a single command { my $one = $finder->find_command( "one" ); # can't test 'code' directly is( { map { $_, $one->$_ } qw( name description package ) }, { name => "one", description => "the one command", package => "MyTest::Commands", }, '$finder->find_command' ); is( scalar $one->arguments, 1, '$one has an argument' ); my ( $arg ) = $one->arguments; is( { map { $_ => $arg->$_ } qw( name description ) }, { name => "arg", description => "the argument", }, 'metadata of argument to one' ); $one->code->( "the argument" ); is( \@called, [ { self => $object, arg => "the argument" } ], 'Invoked code sees invocant object' ); } done_testing; Commandable-0.14/t/20command-args.t000444001750001750 444314667075260 15702 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Invocation; use Commandable::Finder::Packages; package MyTest::Command::one { use constant COMMAND_NAME => "one"; use constant COMMAND_DESC => "a basic command"; use constant COMMAND_ARGS => ( { name => "arg", description => "the argument" } ); sub run {} } package MyTest::Command::optarg { use constant COMMAND_NAME => "optarg"; use constant COMMAND_DESC => "a command with an optional argument"; use constant COMMAND_ARGS => ( { name => "arg", description => "the argument", optional => 1 } ); sub run {} } package MyTest::Command::slurpyarg { use constant COMMAND_NAME => "slurpyarg"; use constant COMMAND_DESC => "a command with a slurpy argument"; use constant COMMAND_ARGS => ( { name => "args", description => "the arguments", slurpy => 1 } ); sub run {} } my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", ); # mandatory arg { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "value" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [qw( value )], '$cmd->parse_invocation with mandatory argument' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); like( dies { $finder->parse_invocation( $cmd, Commandable::Invocation->new( "" ) ) }, qr/^Expected a value for 'arg' argument/, '$cmd->parse_invocation fails with no argument' ); } # optional arg { my $cmd = $finder->find_command( "optarg" ); my $inv = Commandable::Invocation->new( "value" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [qw( value )], '$cmd->parse_invocation with optional argument present' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); is( [ $finder->parse_invocation( $cmd, Commandable::Invocation->new( "" ) ) ], [], '$cmd->parse_invocation with optional argument absent' ); } # slurpy arg { my $cmd = $finder->find_command( "slurpyarg" ); my $inv = Commandable::Invocation->new( "x y z" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ [qw( x y z )] ], '$cmd->parse_invocation with slurpy argument' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } done_testing; Commandable-0.14/t/21command-opts.t000444001750001750 1542414667075260 15755 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Invocation; use Commandable::Finder::Packages; package MyTest::Command::one { use constant COMMAND_NAME => "one"; use constant COMMAND_DESC => "the one command"; use constant COMMAND_OPTS => ( { name => "verbose|v", description => "verbose option", mode => "inc" }, { name => "target|t=", description => "target option" }, { name => "multi", description => "multi option", multi => 1 }, { name => "hyphenated-name|h", description => "option with hyphen in its name" }, { name => "number|n=i", description => "number option" }, { name => "count|c=u", description => "count option" }, { name => "size=f", description => "float option" }, ); sub run {} } package MyTest::Command::two { use constant COMMAND_NAME => "two"; use constant COMMAND_DESC => "the two command"; use constant COMMAND_OPTS => ( { name => "with-default", description => "default option", default => "value" }, ); sub run {} } package MyTest::Command::three { use constant COMMAND_NAME => "three"; use constant COMMAND_DESC => "the three command"; use constant COMMAND_OPTS => ( { name => "silent", description => "silent option", mode => "bool", default => 1 }, ); sub run {} } my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", ); # no opt { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ {} ], '$cmd->parse_invocation with no options' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # opt by longname { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "--verbose" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { verbose => 1 } ], '$cmd->parse_invocation with longname' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # opt by shortname { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "-v" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { verbose => 1 } ], '$cmd->parse_invocation with shortname' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # hyphen converts to underscore { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "-h" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { hyphenated_name => 1 } ], '$cmd->parse_invocation with hyphenated name' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # opt with value (space) { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "--target TARG" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { target => "TARG" } ], '$cmd->parse_invocation with space-separated value' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # opt with value (equals) { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "--target=TARG" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { target => "TARG" } ], '$cmd->parse_invocation with equals-separated value' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # multi value { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "--multi=one --multi two" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { multi => [ qw(one two) ] } ], '$cmd->parse_invocation with repeated value' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # opt with default value { my $cmd = $finder->find_command( "two" ); my $inv = Commandable::Invocation->new( "" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { with_default => "value" } ], '$cmd->parse_invocation with default option' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # negatable opt with default value { my $cmd = $finder->find_command( "three" ); my $inv = Commandable::Invocation->new( "" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { silent => 1 } ], '$cmd->parse_invocation with negatable option' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # negated opt with default value { my $cmd = $finder->find_command( "three" ); my $inv = Commandable::Invocation->new( "--no-silent" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { silent => !!0 } ], '$cmd->parse_invocation with negated option' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # incrementable opt { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "-v -v -v" ); is( [ $finder->parse_invocation( $cmd, $inv ) ], [ { verbose => 3 } ], '$cmd->parse_invocation with repeated incrementable option' ); ok( !length $inv->peek_remaining, '->parse_invocation consumed input' ); } # incrementable opts can't take values { my $cmd = $finder->find_command( "one" ); my $inv = Commandable::Invocation->new( "-v3" ); like( dies { $finder->parse_invocation( $cmd, $inv ) }, qr/^Unexpected value for parameter verbose/, '$cmd->parse_invocation fails with value to incrementable option' ); } # typed options { my $cmd = $finder->find_command( "one" ); ok( lives { is( [ $finder->parse_invocation( $cmd, Commandable::Invocation->new( "-n1" ) ) ], [ { number => 1 } ], '$cmd->parse_invocation with integer-numerical option' ); } ); like( dies { $finder->parse_invocation( $cmd, Commandable::Invocation->new( "-nBAD" ) ) }, qr/^Value for --number option must be an integer/, '$cmd->parse_invocation fails with non-integer value' ); ok( lives { is( [ $finder->parse_invocation( $cmd, Commandable::Invocation->new( "-c5" ) ) ], [ { count => 5 } ], '$cmd->parse_invocation with integer count option' ); } ); like( dies { $finder->parse_invocation( $cmd, Commandable::Invocation->new( "-c-5" ) ) }, qr/^Value for --count option must be a non-negative integer/, '$cmd->parse_invocation fails with negative count' ); ok( lives { is( [ $finder->parse_invocation( $cmd, Commandable::Invocation->new( "--size=1.234" ) ) ], [ { size => 1.234 } ], '$cmd->parse_invocation with size option' ); } ); like( dies { $finder->parse_invocation( $cmd, Commandable::Invocation->new( "--size=BAD" ) ) }, qr/^Value for --size option must be a floating-point number/, '$cmd->parse_invocation fails with bad size' ); } done_testing; Commandable-0.14/t/30finder-invoke.t000444001750001750 372314667075260 16073 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::Packages; my $cmd_opts; my $cmd_args; package MyTest::Command::cmd { use constant COMMAND_NAME => "cmd"; use constant COMMAND_DESC => "the cmd command"; use constant COMMAND_ARGS => ( { name => "arg", description => "the argument", optional => 1 } ); use constant COMMAND_OPTS => ( { name => "verbose|v", description => "verbose option" }, { name => "target|t=", description => "target option" }, ); sub run { $cmd_opts = shift; $cmd_args = [ @_ ]; } } my $cmd2_args; package MyTest::Command::cmd2 { use constant COMMAND_NAME => "cmd2"; use constant COMMAND_DESC => "the cmd2 command"; use constant COMMAND_ARGS => ( { name => "arg", description => "the argument" }, ); sub run { $cmd2_args = [ @_ ]; } } my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", allow_multiple_commands => 1, ); # no args { undef $cmd_args; $finder->find_and_invoke_list( qw( cmd ) ); ok( defined $cmd_args, 'cmd command invoked' ); is( $cmd_args, [], 'cmd command given no args' ); } # one arg { undef $cmd_args; $finder->find_and_invoke_list( qw( cmd argument ) ); is( $cmd_args, [ "argument" ], 'cmd command given one arg' ); } # one option { undef $cmd_args; undef $cmd_opts; $finder->find_and_invoke_list( qw( cmd --verbose ) ); is( $cmd_args, [], 'cmd command given one option' ); is( $cmd_opts, { verbose => 1 }, 'cmd command given one option' ); } # two options { undef $cmd_args; undef $cmd_opts; $finder->find_and_invoke_list( qw( cmd --verbose --target=red ) ); is( $cmd_args, [], 'cmd command given two options' ); is( $cmd_opts, { verbose => 1, target => "red" }, 'cmd command given two options' ); } # multiple commands { undef $cmd_args; undef $cmd_opts; $finder->find_and_invoke_list( qw( cmd arg cmd2 arg2 ) ); } done_testing; Commandable-0.14/t/31finder-config.t000444001750001750 341414667075260 16043 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::Packages; my $cmd_opts; my $cmd_args; package MyTest::Command::cmd { use constant COMMAND_NAME => "cmd"; use constant COMMAND_DESC => "the cmd command"; use constant COMMAND_ARGS => ( { name => "args", description => "the argument", slurpy => 1 }, ); use constant COMMAND_OPTS => ( { name => "opt", description => "the option", multi => 1 }, { name => "verbose|v", description => "verbose", mode => "inc" }, ); sub run { $cmd_opts = shift; $cmd_args = [ @_ ]; } } # don't require order { my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", allow_multiple_commands => 1, ); undef $cmd_opts; undef $cmd_args; $finder->find_and_invoke_list( qw( cmd --opt one arg --opt two more ) ); is( $cmd_opts, { opt => [qw( one two) ] }, 'unordered options' ); is( $cmd_args, [ [ qw( arg more ) ] ], 'unordered args' ); } # require order { my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", allow_multiple_commands => 1, require_order => 1 ); undef $cmd_opts; undef $cmd_args; $finder->find_and_invoke_list( qw( cmd --opt one arg --opt two more ) ); is( $cmd_opts, { opt => [qw( one ) ] }, 'ordered options' ); is( $cmd_args, [ [ qw( arg --opt two more ) ] ], 'ordered args' ); } # bundling { my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", bundling => 1, ); undef $cmd_opts; undef $cmd_args; $finder->find_and_invoke_list( qw( cmd -vvv arg ) ); is( $cmd_opts, { verbose => 3 }, 'bundled options' ); is( $cmd_args, [ [ qw( arg ) ] ], 'bundled args' ); } done_testing(); Commandable-0.14/t/32finder-global-opts.t000444001750001750 325314667075260 17023 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::Packages; my $cmd_opts; package MyTest::Command::cmd { use constant COMMAND_NAME => "cmd"; use constant COMMAND_DESC => "the cmd command"; use constant COMMAND_OPTS => ( { name => "verbose|v", description => "verbose option" }, { name => "target|t=", description => "target option" }, ); sub run { $cmd_opts = shift; } } my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", ); my $THREE; $finder->add_global_options( { name => "one", into => \my $ONE }, { name => "two=", into => \my $TWO, default => 444 }, { name => "three=", into => sub { $THREE = $_[1] } }, ); { undef $ONE; undef $TWO; undef $THREE; $finder->find_and_invoke_list( qw( --one --two=222 --three=three cmd ) ); is( $ONE, T(), '$ONE is true after --one' ); is( $TWO, 222, '$TWO is 222 after --two=222' ); is( $THREE, "three", '$THREE is three after --three=three' ); } # mixed ordering { undef $ONE; undef $TWO; undef $THREE; $finder->find_and_invoke_list( qw( cmd --three=later ) ); is( $THREE, "later", '$THREE is parsed even after command name' ); } # command-specific opts still work { undef $TWO; undef $cmd_opts; $finder->find_and_invoke_list( qw( cmd --three=abc --target=def ) ); is( $THREE, "abc", '$THREE is parsed with command opt' ); is( $cmd_opts, { target => "def" }, 'target is parsed with command opt' ); } # defaults { undef $ONE; undef $TWO; $finder->find_and_invoke_list( qw( cmd ) ); is( $ONE, F(), '$ONE defaults false' ); is( $TWO, 444, '$TWO defaults to 444' ); } done_testing; Commandable-0.14/t/50builtin-help.t000444001750001750 500714667075260 15726 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; use Commandable::Finder::Packages; use Commandable::Invocation; package MyTest::Command::one { use constant COMMAND_NAME => "one"; use constant COMMAND_DESC => "the one command"; use constant COMMAND_ARGS => ( { name => "arg", description => "the argument" } ); use constant COMMAND_OPTS => ( { name => "verbose|v", description => "verbose option" }, { name => "target|t=", description => "target option" }, { name => "silent", description => "silent option", negatable => 1 }, ); sub run {} } package MyTest::Command::two { use constant COMMAND_NAME => "two"; use constant COMMAND_DESC => "the two command"; sub run {} } my $finder = Commandable::Finder::Packages->new( base => "MyTest::Command", ); $finder->add_global_options( { name => "one", into => \my $ONE, description => "the 'one' option" }, { name => "two=", into => \my $TWO, default => 444, description => "the 'two' option" }, ); sub output_from_command { my ( $cmd ) = @_; my $output; no warnings 'redefine'; local *Commandable::Output::printf = sub { shift; my ( $fmt, @args ) = @_; $output .= sprintf $fmt, @args; }; $finder->find_and_invoke( Commandable::Invocation->new( $cmd ) ); return $output; } # Output redirection { my $output = output_from_command( "help" ); is( $output, <<'EOF', 'Output from builtin help command' ); COMMANDS: help: Display a list of available commands one : the one command two : the two command GLOBAL OPTIONS: --one the 'one' option --two the 'two' option (default: 444) EOF } # Output heading formatting { no warnings 'redefine'; local *Commandable::Output::format_heading = sub { shift; my ( $text, $level ) = @_; $level //= 1; return sprintf "%s %s %s", "*" x $level, $text, "*" x $level; }; local *Commandable::Output::format_note = sub { shift; my ( $text, $level ) = @_; $level //= 0; return sprintf "%s%s%s", "<"x($level+1), $text, ">"x($level+1); }; my $output = output_from_command( "help one" ); is( $output, <<'EOF', 'Output from builtin "help one" command' ); - the one command * SYNOPSIS: * one [OPTIONS...] $ARG * OPTIONS: * <<--[no-]silent>> silent option <<--target >>, <<-t >> target option <<--verbose>>, <<-v>> verbose option * ARGUMENTS: * <<$ARG>> the argument EOF } done_testing; Commandable-0.14/t/99pod.t000444001750001750 25514667075260 14111 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Test2::V0; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok();