CLI-Osprey-0.09000755001750001750 015105372346 13261 5ustar00andrewandrew000000000000README100644001750001750 55715105372346 14211 0ustar00andrewandrew000000000000CLI-Osprey-0.09This archive contains the distribution CLI-Osprey, version 0.09: MooX::Options + MooX::Cmd + Sanity This software is copyright (c) 2025 by Andrew Rodland. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.036. LICENSE100644001750001750 4630715105372346 14401 0ustar00andrewandrew000000000000CLI-Osprey-0.09This software is copyright (c) 2025 by Andrew Rodland. 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) 2025 by Andrew Rodland. 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. 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, see . 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 Moe Ghoul, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2025 by Andrew Rodland. 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 Changes100644001750001750 307315105372346 14640 0ustar00andrewandrew000000000000CLI-Osprey-0.09Version 0.09: 2025-11-13 Version 0.08: 2020-07-12 * Fix the mapping of underscores in attribute names to dashes in option names (sivoais again). Although this makes things work as documented, and as they were always intended to work, it may be a breaking change if you were relying on old incorrect behavior. Version 0.07: 2020-07-02 * Fix inline subcommands, broken by 0.06 (sivoais). Version 0.06: 2020-06-30 * Fix incorrect and weird handling of short options when "abbreviate" mode is enabled. Only "--" style long options will be considered as possible abbreivations (Pete Sergeant, vague666). * Optionally load subcommands only on demand, for faster startup of large applications (Yanick Champoux). * Fix a documentation error regarding preserve_argv (vague666). Version 0.05: 2020-02-27 * Fix "prefer_commandline" import option to work properly (thanks ufobat). * Use Moo::Role->is_role to check whether we're being used in a role (thanks djerius). * Add missing methods to CLI::Osprey::Descriptive::Usage (fixes 'Can't locate object method 'die'") (thanks djerius). * Remove test dependency on Test2 for lighter installs. * Fix "description_pod" and "extra_pod" import options (thanks yanick). * Fix a cpanfile version req that didn't match the "use" version req (thanks yanick). Version 0.04: 2018-07-22 * Fix "added_order" option. Version 0.03: 2017-12-09 * Fix line wrapping for "Subcommands available" list Version 0.02: 2017-09-30 * Add missing prereq: Path::Tiny Version 0.01: 2017-07-30 * Initial release META.yml100644001750001750 175715105372346 14625 0ustar00andrewandrew000000000000CLI-Osprey-0.09--- abstract: 'MooX::Options + MooX::Cmd + Sanity' author: - 'Andrew Rodland ' build_requires: Capture::Tiny: '0' Test::Lib: '0' Test::More: '1' configure_requires: Module::Build::Tiny: '0.034' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.036, 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: CLI-Osprey no_index: directory: - t requires: Getopt::Long::Descriptive: '0.100' Module::Runtime: '0' Moo: '0' Moo::Role: '0' Path::Tiny: '0' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=CLI-Osprey homepage: http://metacpan.org/release/CLI-Osprey license: http://dev.perl.org/licenses/ repository: git://github.com/arodland/CLI-Osprey.git version: '0.09' x_authority: cpan:ARODLAND x_generated_by_perl: v5.40.0 x_serialization_backend: 'YAML::Tiny version 1.76' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644001750001750 102415105372346 14470 0ustar00andrewandrew000000000000CLI-Osprey-0.09# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.036. Build.PL Changes LICENSE MANIFEST META.json META.yml README cpanfile dist.ini eg/test.pl lib/CLI/Osprey.pm lib/CLI/Osprey/Descriptive.pm lib/CLI/Osprey/Descriptive/Usage.pm lib/CLI/Osprey/InlineSubcommand.pm lib/CLI/Osprey/Role.pm t/basic.t t/lib/MyTest/Class/Basic.pm t/lib/MyTest/Class/Basic/Yell.pm t/lib/OnDemand.pm t/lib/OnDemand/Bar.pm t/lib/OnDemand/Foo.pm t/lib/PodApp.pm t/load-on-use.t t/loaded-by-default.t t/pod_generation.t t/usage_api.t dist.ini100644001750001750 26015105372346 14764 0ustar00andrewandrew000000000000CLI-Osprey-0.09name = CLI-Osprey author = Andrew Rodland copyright_holder = Andrew Rodland license = Perl_5 [@ARODLAND] dist = CLI-Osprey prereqs = cpanfile [PodWeaver] cpanfile100644001750001750 36615105372346 15033 0ustar00andrewandrew000000000000CLI-Osprey-0.09requires 'Moo'; requires 'Moo::Role'; requires 'Getopt::Long::Descriptive' => '0.100'; requires 'Module::Runtime'; requires 'Path::Tiny'; on 'test' => sub { requires 'Test::More' => 1; requires 'Test::Lib'; requires 'Capture::Tiny'; }; Build.PL100644001750001750 25715105372346 14622 0ustar00andrewandrew000000000000CLI-Osprey-0.09# This Build.PL for CLI-Osprey was generated by Dist::Zilla::Plugin::ModuleBuildTiny 0.020. use strict; use warnings; use 5.006; use Module::Build::Tiny 0.034; Build_PL(); t000755001750001750 015105372346 13445 5ustar00andrewandrew000000000000CLI-Osprey-0.09basic.t100644001750001750 2034015105372346 15072 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t#! perl use Test::More; use Capture::Tiny qw( capture ); use Test::Lib; use MyTest::Class::Basic; subtest 'command' => sub { subtest "default options" => sub { local @ARGV = (); my ( $stdout, $stderr, @result ) = capture { MyTest::Class::Basic->new_with_options->run }; is ( $stdout, "Hello world!\n", "message sent to stdout" ); is ( $stderr, '', "empty stderr" ); }; subtest "command line options" => sub { local @ARGV = ( '--message', 'Hello Cleveland!' ); my ( $stdout, $stderr, @result ) = capture { MyTest::Class::Basic->new_with_options->run }; is ( $stdout, "Hello Cleveland!\n", "message sent to stdout" ); is ( $stderr, '', "empty stderr" ); }; }; subtest 'subcommand' => sub { subtest 'yell class subcommand' => sub { require CLI::Osprey::Role; require MyTest::Class::Basic::Yell; my %options = MyTest::Class::Basic::Yell->_osprey_options(); # Helper function: get getopt string for an option my $get_getopt_string = sub { my ($option_name) = @_; my %attrs = %{ $options{$option_name} }; my $getopt = CLI::Osprey::Role::_osprey_option_to_getopt($option_name, %attrs); note("$option_name getopt string: $getopt"); return $getopt; }; # Helper function: run yell command and capture output my $run_yell_command = sub { my (@args) = @_; local @ARGV = ('yell', @args); local *CORE::exit = sub { }; # Prevent exit() from terminating test process my ($stdout, $stderr, @result) = capture { MyTest::Class::Basic->new_with_options->run }; return ($stdout, $stderr); }; # Helper function: run yell command and test output my $test_yell_command = sub { my ($args, $stdout_pattern, $description) = @_; my ($stdout, $stderr) = $run_yell_command->(@$args); like($stdout, $stdout_pattern, $description); is($stderr, '', "empty stderr"); return ($stdout, $stderr); }; subtest "default options" => sub { $test_yell_command->([], qr{^\QHELLO WORLD!\E\n$}, "message sent to stdout"); }; subtest "output_format option" => sub { subtest "internal: generates hyphenated getopt string" => sub { my $getopt = $get_getopt_string->('output_format'); like($getopt, qr{\Qoutput-format\E}, "generates hyphenated getopt string"); unlike($getopt, qr{\Qoutput_format\E}, "does not generate underscored getopt string"); }; subtest "functional: --output-format long option" => sub { $test_yell_command->([qw(--output-format xml)], qr{\QHELLO WORLD!\E}, "XML format output"); }; subtest "functional: -f short option" => sub { $test_yell_command->([qw(-f json)], qr{\Q"yell": "HELLO WORLD!"\E}, "JSON format output"); }; }; subtest "excitement_level option" => sub { subtest "internal: generates hyphenated getopt string" => sub { my $getopt = $get_getopt_string->('excitement_level'); like($getopt, qr{\Qexcitement-level\E}, "generates hyphenated getopt string"); unlike($getopt, qr{\Qexcitement_level\E}, "does not generate underscored getopt string"); }; subtest "functional: --excitement-level" => sub { $test_yell_command->([qw(--excitement-level 2)], qr{^\QHELLO WORLD!!!\E\n$}, "excitement level adds exclamation marks"); }; }; subtest "repeat_count option" => sub { subtest "functional: -r short option" => sub { my ($stdout, $stderr) = $run_yell_command->(qw(-r 3)); my @lines = split /\n/, $stdout; is ( scalar(@lines), 3, "repeated 3 times" ); is ( $lines[0], "HELLO WORLD!", "first line correct" ); is ( $stderr, '', "empty stderr" ); }; }; subtest "custom_suffix option (custom option name)" => sub { subtest "internal: generates custom option name getopt string" => sub { my $getopt = $get_getopt_string->('custom_suffix'); like($getopt, qr{\Qadd-suffix\E}, "generates custom 'add-suffix' getopt string"); unlike($getopt, qr{custom[_-]suffix}, "does not generate attribute name in getopt string"); is($getopt, 'add-suffix|s=s', "complete getopt string uses custom option name"); }; subtest "functional: -s short option" => sub { $test_yell_command->([qw(-s), '[BOOM]'], qr{\QHELLO WORLD![BOOM]\E}, "custom suffix added via -s"); }; subtest "functional: --add-suffix long option" => sub { $test_yell_command->([qw(--add-suffix), '[POW]'], qr{\QHELLO WORLD![POW]\E}, "custom suffix added via --add-suffix"); }; }; subtest "add_tag option (negatable)" => sub { subtest "internal: generates hyphenated negatable getopt string" => sub { my $getopt = $get_getopt_string->('add_tag'); like($getopt, qr{\Qadd-tag!\E}, "generates hyphenated negatable getopt string"); unlike($getopt, qr{\Qadd_tag\E}, "does not generate underscored getopt string"); }; subtest "functional: --add-tag" => sub { $test_yell_command->([qw(--add-tag)], qr{\Q[TAG] HELLO WORLD!\E}, "tag added via --add-tag"); }; subtest "functional: --no-add-tag" => sub { my ($stdout, $stderr) = $run_yell_command->(qw(--no-add-tag)); unlike($stdout, qr{\Q[TAG]\E}, "no tag when disabled via --no-add-tag"); like($stdout, qr{^\QHELLO WORLD!\E$}, "plain output"); is($stderr, '', "empty stderr"); }; }; subtest "abbreviate feature" => sub { subtest "--out abbreviates --output-format" => sub { $test_yell_command->([qw(--out xml)], qr{\QHELLO WORLD!\E}, "abbreviated --out works for --output-format"); }; subtest "--output-form abbreviates --output-format" => sub { $test_yell_command->([qw(--output-form xml)], qr{\QHELLO WORLD!\E}, "abbreviated --output-form works for --output-format"); }; }; subtest "combinations" => sub { subtest "minimum failing case: short + hyphenated long" => sub { $test_yell_command->([qw(-f xml --excitement-level 2)], qr{\QHELLO WORLD!!!\E}, "XML format via -f with excitement-level 2"); }; subtest "multiple hyphenated long options" => sub { my ($stdout, $stderr) = $run_yell_command->(qw(--excitement-level 2 --output-format xml --repeat-count 2)); my @lines = split /\n/, $stdout; is ( scalar(@lines), 2, "repeated 2 times" ); like ( $lines[0], qr{\QHELLO WORLD!!!\E}, "XML with excitement-level 2" ); is ( $stderr, '', "empty stderr" ); }; subtest "custom option + other options" => sub { $test_yell_command->([qw(-f xml --add-suffix), '[ZAP]', qw(--excitement-level 1)], qr{\QHELLO WORLD!![ZAP]\E}, "custom suffix combined with format and excitement"); }; }; }; subtest "inline subcommand" => sub { local @ARGV = qw ( whisper ); local *CORE::exit = sub { }; my ($stdout, $stderr) = capture { MyTest::Class::Basic->new_with_options->run }; is ( $stdout, "hello world!\n", "message sent to stdout" ); is ( $stderr, '', "empty stderr" ); }; }; done_testing; META.json100644001750001750 333615105372346 14770 0ustar00andrewandrew000000000000CLI-Osprey-0.09{ "abstract" : "MooX::Options + MooX::Cmd + Sanity", "author" : [ "Andrew Rodland " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.036, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "CLI-Osprey", "no_index" : { "directory" : [ "t" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.034" } }, "runtime" : { "requires" : { "Getopt::Long::Descriptive" : "0.100", "Module::Runtime" : "0", "Moo" : "0", "Moo::Role" : "0", "Path::Tiny" : "0" } }, "test" : { "requires" : { "Capture::Tiny" : "0", "Test::Lib" : "0", "Test::More" : "1" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-CLI-Osprey@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=CLI-Osprey" }, "homepage" : "http://metacpan.org/release/CLI-Osprey", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/arodland/CLI-Osprey.git", "web" : "http://github.com/arodland/CLI-Osprey" } }, "version" : "0.09", "x_authority" : "cpan:ARODLAND", "x_generated_by_perl" : "v5.40.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.40", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } eg000755001750001750 015105372346 13575 5ustar00andrewandrew000000000000CLI-Osprey-0.09test.pl100644001750001750 140215105372346 15246 0ustar00andrewandrew000000000000CLI-Osprey-0.09/egpackage Foo; use Moo; use CLI::Osprey doc => "The Moo Foo", added_order => 1; option opt => ( is => 'ro', format => 's', ); option abc => ( is => 'ro', format => 's', ); sub run { warn "foo\n"; } subcommand bar => 'Foo::Bar'; subcommand baz => sub { my ($self, @args) = @_; use Data::Dumper; warn "inline ", Dumper(\@_); }, doc => "baz luhrmann"; no Moo; package Foo::Bar; use Moo; use CLI::Osprey doc => "bars the foos"; option opt => ( is => 'ro', format => 's', ); sub run { warn "bar\n"; } package main; use Data::Dumper; #print Dumper({ Foo->_osprey_config }); #print Dumper({ Foo->_osprey_options }); #print Dumper({ Foo->_osprey_subcommands }); my $obj = Foo->new_with_options; print Dumper($obj); print Dumper($obj->run); usage_api.t100644001750001750 66115105372346 15712 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t#! perl use Test::More; use CLI::Osprey::Descriptive::Usage; ok 'CLI::Osprey::Descriptive::Usage'->can($_), "can_ok $_" for ( 'new', 'text', 'leader_text', 'warn', 'die', # option_text() is part of the Getopt::Long::Descriptive::Usage API, but # seems only to be used within ::Usage, so maybe it doesn't need # to be implemented? # 'option_text', ); done_testing; load-on-use.t100644001750001750 136515105372346 16122 0ustar00andrewandrew000000000000CLI-Osprey-0.09/tuse strict; use warnings; use Test::More; use lib 't/lib'; BEGIN { $::on_demand = 1; } use OnDemand; plan tests => 4; subtest 'no subcommand loaded at the start' => sub { ok !$OnDemand::Foo::loaded; ok !$OnDemand::Bar::loaded; }; subtest 'created object, still no subcommand loaded' => sub { OnDemand->new_with_options; ok !$OnDemand::Foo::loaded; ok !$OnDemand::Bar::loaded; }; subtest 'app ran, still no subcommand loaded' => sub { OnDemand->new_with_options->run; ok !$OnDemand::Foo::loaded; ok !$OnDemand::Bar::loaded; }; subtest 'app ran w/ subcommand foo, only foo loaded' => sub { @ARGV = qw/ foo /; OnDemand->new_with_options->run; ok $OnDemand::Foo::loaded; ok !$OnDemand::Bar::loaded; }; lib000755001750001750 015105372346 14213 5ustar00andrewandrew000000000000CLI-Osprey-0.09/tPodApp.pm100644001750001750 21515105372346 16052 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t/libpackage PodApp; use Moo; use CLI::Osprey description_pod => 'some description pod', extra_pod => 'some extra pod'; sub run {} 1; OnDemand.pm100644001750001750 23715105372346 16360 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t/libpackage OnDemand; use Moo; use CLI::Osprey on_demand => $::on_demand; subcommand foo => 'OnDemand::Foo'; subcommand bar => 'OnDemand::Bar'; sub run { } 1; CLI000755001750001750 015105372346 14357 5ustar00andrewandrew000000000000CLI-Osprey-0.09/libOsprey.pm100644001750001750 3774115105372346 16372 0ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLIpackage CLI::Osprey; use strict; use warnings; # ABSTRACT: MooX::Options + MooX::Cmd + Sanity our $VERSION = '0.09'; # VERSION our $AUTHORITY = 'cpan:ARODLAND'; # AUTHORITY use Carp 'croak'; use Module::Runtime 'use_module'; use Scalar::Util qw(reftype); use Moo::Role qw(); # only want class methods, not setting up a role use CLI::Osprey::InlineSubcommand (); my @OPTIONS_ATTRIBUTES = qw( option option_name format short repeatable negatable spacer_before spacer_after doc long_doc format_doc order hidden ); sub import { my (undef, @import_options) = @_; my $target = caller; for my $method (qw(with around has)) { next if $target->can($method); croak "Can't find the method '$method' in package '$target'. CLI::Osprey requires a Role::Tiny-compatible object system like Moo or Moose."; } my $with = $target->can('with'); my $around = $target->can('around'); my $has = $target->can('has'); if ( ! Moo::Role->is_role( $target ) ) { # not in a role eval "package $target;\n" . q{ sub _osprey_options { my $class = shift; return $class->maybe::next::method(@_); } sub _osprey_config { my $class = shift; return $class->maybe::next::method(@_); } sub _osprey_subcommands { my $class = shift; return $class->maybe::next::method(@_); } 1; } || croak($@); } my $osprey_config = { preserve_argv => 1, abbreviate => 1, prefer_commandline => 1, @import_options, }; $around->(_osprey_config => sub { my ($orig, $self) = (shift, shift); return $self->$orig(@_), %$osprey_config; }); my $options_data = { }; my $subcommands = { }; my $apply_modifiers = sub { return if $target->can('new_with_options'); $with->('CLI::Osprey::Role'); $around->(_osprey_options => sub { my ($orig, $self) = (shift, shift); return $self->$orig(@_), %$options_data; }); $around->(_osprey_subcommands => sub { my ($orig, $self) = (shift, shift); return $self->$orig(@_), %$subcommands; }); }; my $added_order = 0; my $option = sub { my ($name, %attributes) = @_; $has->($name => _non_option_attributes(%attributes)); $options_data->{$name} = _option_attributes($name, %attributes); $options_data->{$name}{added_order} = ++$added_order; $apply_modifiers->(); }; my $subcommand = sub { my ($name, $subobject) = @_; if (ref($subobject) && reftype($subobject) eq 'CODE') { my @args = @_[2 .. $#_]; $subobject = CLI::Osprey::InlineSubcommand->new( name => $name, method => $subobject, @args, ); } else { use_module($subobject) unless $osprey_config->{on_demand}; } $subcommands->{$name} = $subobject; $apply_modifiers->(); }; if (my $info = $Role::Tiny::INFO{$target}) { $info->{not_methods}{$option} = $option; $info->{not_methods}{$subcommand} = $subcommand; } { no strict 'refs'; *{"${target}::option"} = $option; *{"${target}::subcommand"} = $subcommand; } $apply_modifiers->(); return; } sub _non_option_attributes { my (%attributes) = @_; my %filter_out; @filter_out{@OPTIONS_ATTRIBUTES} = (); return map { $_ => $attributes{$_} } grep { !exists $filter_out{$_} } keys %attributes; } sub _option_attributes { my ($name, %attributes) = @_; unless (defined $attributes{option}) { ($attributes{option} = $name) =~ tr/_/-/; } my $ret = {}; for (@OPTIONS_ATTRIBUTES) { $ret->{$_} = $attributes{$_} if exists $attributes{$_}; } return $ret; } 1; __END__ =pod =encoding UTF-8 =head1 NAME CLI::Osprey - MooX::Options + MooX::Cmd + Sanity =head1 VERSION version 0.09 =head1 SYNOPSIS in Hello.pm package Hello; use Moo; use CLI::Osprey; option 'message' => ( is => 'ro', format => 's', doc => 'The message to display', default => 'Hello world!', ); sub run { my ($self) = @_; print $self->message, "\n"; } In hello.pl use Hello; Hello->new_with_options->run; =head1 DESCRIPTION CLI::Osprey is a module to assist in writing commandline applications with M* OO modules (Moose, Moo, Mo). With it, you structure your app as one or more modules, which get instantiated with the commandline arguments as attributes. Arguments are parsed using L, and both long and short help messages as well as complete manual pages are automatically generated. An app can be a single command with options, or have sub-commands (like C). Sub-commands can be defined as modules (with options of their own) or as simple coderefs. =head2 Differences from MooX::Options Osprey is deliberately similar to L, and porting an app that uses MooX::Options to Osprey should be fairly simple in most cases. However there are a few important differences: =over 4 =item * Osprey is pure-perl, without any mandatory XS dependencies, meaning it can be used in fatpacked scripts, and other situations where you may need to run on diverse machines, where a C compiler and control over the ennvironment aren't guaranteed. =item * Osprey's support for sub-commands is built-in from the beginning. We think this makes for a better experience than MooX::Options + MooX::Cmd. =item * While MooX::Options requires an option's primary name to be the same as the attribute that holds it, and MooX::Cmd derives a sub-command's name from the name of the module that implements it, Osprey separates these, so that Perl identifier naming conventions don't dictate your command line interface. =item * Osprey doesn't use an automatic module finder (like L) to locate modules for sub-commands; their names are given explicitly. This small amount of additional typing gives you more control and less fragility. =back There are also a few things MooX::Options has that Osprey lacks. While they may be added in the future, I haven't seen the need yet. Currently known missing feeatures are JSON options, C support, C, and C. For JSON support, you can use a coercion on the attribute, turning it from a string to a ref via C. To default an app's options from a config file, you may want to do something like this in your script file: use JSON 'decode_json'; use Path::Tiny; MyApp->new_with_options( map decode_json(path($_)->slurp), grep -f, "$ENV{HOME}/.myapprc" )->run; Provided that C is true (which is the default), any options in C<.myapprc> will be used as defaults if that file exists, but will still be overrideable from the commandline. =head1 IMPORTED METHODS The following methods, will be imported into a class that uses CLI::Osprey: =head2 new_with_options Parses commandline arguments, validates them, and calls the C method with the resulting parameters. Any parameters passed to C will also be passed to C; the C import option controls which overrides which. =head2 option The C for usage. =head2 osprey_usage($code, @messages) Displays a short usage message, the same as if the app was invoked with the C<-h> option. Also displays the lines of text in C<@messages> if any are passed. If C<$code> is passed a defined value, exits with that as a status. =head2 osprey_help($code) Displays a more substantial usage message, the same as if the app was invoked with the C<--help> option. If C<$code> is passed a defined value, exits with that as a status. =head2 osprey_man Displays a manual page for the app, containing long descriptive text (if provided) about each command and option, then exits. =for comment osprey_man has parameters, the first one is for internal usage only and the second one is obscure... just ignore them until I sort it out. =head1 IMPORT PARAMETERS The parameters to C serve two roles: to customize Osprey's behavior, and to provide information about the app and its options for use in the usage messages. They are: =head2 abbreviate Default: true. If C is set to a true value, then long options can be abbreviated to the point of uniqueness. That is, C<--long-option-name> can be called as C<--lon> as long as there are no other options starting with those letters. An option can always be called by its full name, even if it is a prefix of some longer option's name. If C is false, options must always be called by their full names (or by a defined short name). =head2 added_order Default: true. If C is set to a true value, then two options with the same C (or none at all) will appear in the help text in the same order as their C is true, and by alphabetical order otherwise. Options without an explicit order are placed as though they had order 9999, so use small values to sort before automatically-sorted options, and values of 10000 or greater to sort at the end. =head2 repeatable Default: B. Allows an option to be specified more than once. When used on a "boolean" option with no L, each appearace of the option will increment the value by 1 (equivalent to C<+> in L). When used on an option with arguments, produces an arrayref, one value per appearance of the option. =head2 required Default: B. This is a Moo/Moose feature honored by Osprey. A C attribute must be passed on the commandline unless it's passed to the constructor. Generated documentation will show the option as non-optional. =head2 short Default: None. Gives an option a single-character "short" form, e.g. C<-v> for C<--verbose>. =head2 spacer_before Default: B. Causes a blank line to appear before this option in help output. =head2 spacer_after Default: B. Causes a blank line to appear after this option in help output. =head1 SUBCOMMANDS An Osprey command can have subcommands with their own options, documentation, etc., allowing for complicated applications under the roof of a single command. Osprey will parse the options for all of the commands in the chain, and construct them in top-to-bottom order, with each subcommand receiving a reference to its parent. =head2 Subcommand Classes A subcommand can be another class, which also uses C. For example: package MyApp; use Moo; use CLI::Osprey; option verbose => ( is => 'ro', short => 'v', ); subcommand frobnicate => 'MyApp::Frobnicate'; package MyApp::Frobnicate; use Moo; use CLI::Osprey; option target => ( is => 'ro', format => 's', ); sub run { my ($self) = @_; if ($self->parent_command->verbose) { say "Be dangerous, and unpredictable... and make a lot of noise."; } $self->do_something_with($self->target); } =head2 Inline Subcommands A subcommand can also be specified as a coderef, for when a separate class would be excessive. For example: package Greet; use Moo; use CLI::Osprey; option target => ( is => 'ro', default => "world", ); subcommand hello => sub { my ($self, $parent) = @_; say "Hello ", $parent->target; }; subcommand goodbye => sub { my ($self, $parent) = @_; say "Goodbye ", $parent->target; }; which can be invoked as C. Inline subcommands are implemented using L. =head1 THANKS This module is based heavily on code from L and takes strong inspiration from L and L. Thanks to celogeek, Jens Reshack, Getty, Tom Bloor, and all contributors to those modules. Thanks to mst for prodding me to do this. Thanks Grinnz for helping me update my dzillage. =head1 AUTHOR Andrew Rodland =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2025 by Andrew Rodland. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut pod_generation.t100644001750001750 47115105372346 16751 0ustar00andrewandrew000000000000CLI-Osprey-0.09/tuse strict; use warnings; use Test::More; use lib 't/lib'; use PodApp; my $app = PodApp->new; my( undef, $usage ) = $app->parse_options; my $pod = $usage->option_pod; like $pod, qr/some description pod/, 'description_pod is present'; like $pod, qr/some extra pod/, 'extra_pod is present'; done_testing(); loaded-by-default.t100644001750001750 126715105372346 17262 0ustar00andrewandrew000000000000CLI-Osprey-0.09/tuse strict; use warnings; use Test::More; use lib 't/lib'; use OnDemand; plan tests => 4; subtest 'subcommand loaded at the start' => sub { ok $OnDemand::Foo::loaded; ok $OnDemand::Bar::loaded; }; subtest 'created object, subcommand still loaded' => sub { OnDemand->new_with_options; ok $OnDemand::Foo::loaded; ok $OnDemand::Bar::loaded; }; subtest 'app ran, subcommand still loaded' => sub { OnDemand->new_with_options->run; ok $OnDemand::Foo::loaded; ok $OnDemand::Bar::loaded; }; subtest 'app ran w/ subcommand foo' => sub { @ARGV = qw/ foo /; OnDemand->new_with_options->run; ok $OnDemand::Foo::loaded; ok $OnDemand::Bar::loaded; }; OnDemand000755001750001750 015105372346 15700 5ustar00andrewandrew000000000000CLI-Osprey-0.09/t/libBar.pm100644001750001750 14015105372346 17055 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t/lib/OnDemandpackage OnDemand::Bar; use Moo; use CLI::Osprey; $OnDemand::Bar::loaded = 1; sub run { } 1; Foo.pm100644001750001750 14015105372346 17074 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t/lib/OnDemandpackage OnDemand::Foo; use Moo; use CLI::Osprey; $OnDemand::Foo::loaded = 1; sub run { } 1; Osprey000755001750001750 015105372346 15640 5ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLIRole.pm100644001750001750 2741315105372346 17266 0ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLI/Ospreypackage CLI::Osprey::Role; use strict; use warnings; use Carp 'croak'; use Path::Tiny (); use Scalar::Util qw(blessed); use Module::Runtime 'use_module'; use CLI::Osprey::Descriptive; # ABSTRACT: Role for CLI::Osprey applications our $VERSION = '0.09'; # VERSION our $AUTHORITY = 'cpan:ARODLAND'; # AUTHORITY sub _osprey_option_to_getopt { my ($name, %attributes) = @_; # Use custom option name if provided, otherwise use attribute name my $option_name = $attributes{option} || $name; my $getopt = join('|', grep defined, ($option_name, $attributes{short})); $getopt .= '+' if $attributes{repeatable} && !defined $attributes{format}; $getopt .= '!' if $attributes{negatable}; $getopt .= '=' . $attributes{format} if defined $attributes{format}; $getopt .= '@' if $attributes{repeatable} && defined $attributes{format}; return $getopt; } sub _osprey_prepare_options { my ($options, $config) = @_; my @getopt; my %abbreviations; my %fullnames; # If options have an 'order' attr, use it; those without sort as though they were 9,999. # If the order is equal (or not present on both) and the 'added_order' config flag is set, # then sort according to added_order. # Otherwise, sort according to option name. my @order = sort { ($options->{$a}{order} || 9999) <=> ($options->{$b}{order} || 9999) || ($config->{added_order} ? ($options->{$a}{added_order} <=> $options->{$b}{added_order}) : 0) || $a cmp $b } keys %$options; for my $option (@order) { my %attributes = %{ $options->{$option} }; push @{ $fullnames{ $attributes{option} } }, $option; } for my $name (keys %fullnames) { if (@{ $fullnames{$name} } > 1) { croak "Multiple option attributes named $name: [@{ $fullnames{$name} }]"; } } for my $option (@order) { my %attributes = %{ $options->{$option} }; my $name = $attributes{option}; my $doc = $attributes{doc}; $doc = "no documentation for $name" unless defined $doc; push @getopt, [] if $attributes{spacer_before}; push @getopt, [ _osprey_option_to_getopt($option, %attributes), $doc, ($attributes{hidden} ? { hidden => 1} : ()) ]; push @getopt, [] if $attributes{spacer_after}; push @{ $abbreviations{$name} }, $option; # If we allow abbreviating long option names, an option can be called by any prefix of its name, # unless that prefix is an option name itself. Ambiguous cases (an abbreviation is a prefix of # multiple option names) are handled later in _osprey_fix_argv. if ($config->{abbreviate}) { for my $len (1 .. length($name) - 1) { my $abbreviated = substr $name, 0, $len; push @{ $abbreviations{$abbreviated} }, $option unless exists $fullnames{$abbreviated}; } } } return \@getopt, \%abbreviations; } # Process ARGV, rewriting options to be what GLD expects them to be. # We only want to rewrite things that GLD will be happy about, because it would be # bad to have GLD generate an error about something being invalid, if it isn't # actually something that the user typed! # Stuff that's done here: # * Rewrite abbreviations to their equivalent full names. # * Rewrite options that were aliased with 'option' or the default underscore-to-dash # rewriting, to their canonical name (the same as the attribute name). # * Recognize '--foo=bar' options and replace them with '--foo bar'. sub _osprey_fix_argv { my ($options, $abbreviations) = @_; my @new_argv; while (defined( my $arg = shift @ARGV )) { # As soon as we find a -- or a non-option word, stop processing and leave everything # from there onwards in ARGV as either positional args or a subcommand. if ($arg eq '--' or $arg eq '-' or $arg !~ /^-/) { push @new_argv, $arg, @ARGV; last; } my ($arg_name_with_dash, $arg_value) = split /=/, $arg, 2; unshift @ARGV, $arg_value if defined $arg_value; my ($dash, $negative, $arg_name_without_dash) = $arg_name_with_dash =~ /^(-+)(no\-)?(.+)$/; my $option_name; # If this is a long option and abbreviations are enabled, search the abbreviation table # for options that match the prefix. If the result is unique, use it. If the result is # ambiguous, set $option_name undef so that eventually we will generate an "unknown option" # error for it. Prefixes that exactly match an option name are excluded from the table, so # that assuming that 'foo' and 'foobar' are both options, '--fo' will be ambiguous, # '--foo' will be unambiguously 'foo' (*not* an error even though there are in fact two # optiions that start with 'foo'), and '--foob' will be 'foobar'. if ($dash eq '--') { my $option_names = $abbreviations->{$arg_name_without_dash}; if (defined $option_names) { if (@$option_names == 1) { $option_name = $option_names->[0]; } else { # TODO: can't we produce a warning saying that it's ambiguous and which options conflict? $option_name = undef; } } } # $option_name is the attribute name (underscored) from abbreviations table # We need to get the actual CLI option name for the rewritten ARGV my $arg_name = ($dash || '') . ($negative || ''); if (defined $option_name) { # Use the custom option name from the options hash if possible $arg_name .= $options->{$option_name}{option} || $option_name; } else { $arg_name .= $arg_name_without_dash; } push @new_argv, $arg_name; if (defined $option_name && $options->{$option_name}{format}) { push @new_argv, shift @ARGV; } } return @new_argv; } use Moo::Role; requires qw(_osprey_config _osprey_options _osprey_subcommands); has 'parent_command' => ( is => 'ro', ); has 'invoked_as' => ( is => 'ro', ); sub new_with_options { my ($class, %params) = @_; my %config = $class->_osprey_config; local @ARGV = @ARGV if $config{protect_argv}; if (!defined $params{invoked_as}) { $params{invoked_as} = Getopt::Long::Descriptive::prog_name(); } my ($parsed_params, $usage) = $class->parse_options(%params); if ($parsed_params->{h}) { return $class->osprey_usage(1, $usage); } elsif ($parsed_params->{help}) { return $class->osprey_help(1, $usage); } elsif ($parsed_params->{man}) { return $class->osprey_man($usage); } my %merged_params; if ($config{prefer_commandline}) { %merged_params = (%params, %$parsed_params); } else { %merged_params = (%$parsed_params, %params); } my %subcommands = $class->_osprey_subcommands; my ($subcommand_name, $subcommand_class); if (@ARGV && $ARGV[0] ne '--') { # Check what to do with remaining options if ($ARGV[0] =~ /^--/) { # Getopt stopped at an unrecognized option, error. print STDERR "Unknown option '$ARGV[0]'.\n"; return $class->osprey_usage(1, $usage); } elsif (%subcommands) { $subcommand_name = shift @ARGV; # Remove it so the subcommand sees only options $subcommand_class = $subcommands{$subcommand_name}; if (!defined $subcommand_class) { print STDERR "Unknown subcommand '$subcommand_name'.\n"; return $class->osprey_usage(1, $usage); } } # If we're not expecting a subcommand, and getopt didn't stop at an option, consider the remainder # as positional args and leave them in ARGV. } my $self; unless (eval { $self = $class->new(%merged_params); 1 }) { if ($@ =~ /^Attribute \((.*?)\) is required/) { print STDERR "$1 is missing\n"; } elsif ($@ =~ /^Missing required arguments: (.*) at /) { my @missing_required = split /,\s/, $1; print STDERR "$_ is missing\n" for @missing_required; } elsif ($@ =~ /^(.*?) required/) { print STDERR "$1 is missing\n"; } elsif ($@ =~ /^isa check .*?failed: /) { print STDERR substr($@, index($@, ':') + 2); } else { print STDERR $@; } return $class->osprey_usage(1, $usage); } return $self unless $subcommand_class; use_module($subcommand_class) unless ref $subcommand_class; return $subcommand_class->new_with_options( %params, parent_command => $self, invoked_as => "$params{invoked_as} $subcommand_name" ); } sub parse_options { my ($class, %params) = @_; my %options = $class->_osprey_options; my %config = $class->_osprey_config; my %subcommands = $class->_osprey_subcommands; my ($options, $abbreviations) = _osprey_prepare_options(\%options, \%config); @ARGV = _osprey_fix_argv(\%options, $abbreviations); my @getopt_options = %subcommands ? qw(require_order) : (); push @getopt_options, @{$config{getopt_options}} if defined $config{getopt_options}; my $prog_name = $params{invoked_as}; $prog_name = Getopt::Long::Descriptive::prog_name() if !defined $prog_name; my $usage_str = $config{usage_string}; unless (defined $usage_str) { if (%subcommands) { $usage_str = "Usage: $prog_name %o [subcommand]"; } else { $usage_str = "Usage: $prog_name %o"; } } my ($opt, $usage) = describe_options( $usage_str, @$options, [], [ 'h', "show a short help message" ], [ 'help', "show a long help message" ], [ 'man', "show the manual" ], { getopt_conf => \@getopt_options }, ); $usage->{prog_name} = $prog_name; $usage->{target} = $class; if ($usage->{should_die}) { return $class->osprey_usage(1, $usage); } my %parsed_params; for my $name (keys %options, qw(h help man)) { # Getopt::Long converts hyphens to underscores; Getopt::Long::Descriptive uses these as method names # For custom option names, we need to retrieve using the option name, not attribute name my $method_name = $name; if (exists $options{$name} && exists $options{$name}{option}) { $method_name = $options{$name}{option}; $method_name =~ tr/-/_/; # Convert hyphens to underscores to match Getopt::Long's conversion } my $val = $opt->$method_name(); $parsed_params{$name} = $val if defined $val; } return \%parsed_params, $usage; } sub osprey_usage { my ($class, $code, @messages) = @_; my $usage; if (@messages && blessed($messages[0]) && $messages[0]->isa('CLI::Osprey::Descriptive::Usage')) { $usage = shift @messages; } else { local @ARGV = (); (undef, $usage) = $class->parse_options(help => 1); } my $message; $message = join("\n", @messages, '') if @messages; $message .= $usage . "\n"; if ($code) { CORE::warn $message; } else { print $message; } exit $code if defined $code; return; } sub osprey_help { my ($class, $code, $usage) = @_; unless (defined $usage && blessed($usage) && $usage->isa('CLI::Osprey::Descriptive::Usage')) { local @ARGV = (); (undef, $usage) = $class->parse_options(help => 1); } my $message = $usage->option_help . "\n"; if ($code) { CORE::warn $message; } else { print $message; } exit $code if defined $code; return; } sub osprey_man { my ($class, $usage, $output) = @_; unless (defined $usage && blessed($usage) && $usage->isa('CLI::Osprey::Descriptive::Usage')) { local @ARGV = (); (undef, $usage) = $class->parse_options(man => 1); } my $tmpdir = Path::Tiny->tempdir; my $podfile = $tmpdir->child("help.pod"); $podfile->spew_utf8($usage->option_pod); require Pod::Usage; Pod::Usage::pod2usage( -verbose => 2, -input => "$podfile", -exitval => 'NOEXIT', -output => $output, ); exit(0); } sub _osprey_subcommand_desc { my ($class) = @_; my %config = $class->_osprey_config; return $config{desc}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME CLI::Osprey::Role - Role for CLI::Osprey applications =head1 VERSION version 0.09 =head1 AUTHOR Andrew Rodland =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2025 by Andrew Rodland. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Class000755001750001750 015105372346 16505 5ustar00andrewandrew000000000000CLI-Osprey-0.09/t/lib/MyTestBasic.pm100644001750001750 61215105372346 20203 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t/lib/MyTest/Classpackage MyTest::Class::Basic; use Moo; use CLI::Osprey; option 'message' => ( is => 'ro', format => 's', doc => 'The message to display', default => 'Hello world!', ); subcommand yell => 'MyTest::Class::Basic::Yell'; subcommand whisper => sub { my ($self) = @_; print lc $self->message, "\n"; }; sub run { my ($self) = @_; print $self->message, "\n"; } 1; Descriptive.pm100644001750001750 201615105372346 20616 0ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLI/Ospreypackage CLI::Osprey::Descriptive; use strict; use warnings; # ABSTRACT: Getopt::Long::Descriptive subclass for CLI::Osprey use our $VERSION = '0.09'; # VERSION our $AUTHORITY = 'cpan:ARODLAND'; # AUTHORITY use Getopt::Long::Descriptive 0.100; use CLI::Osprey::Descriptive::Usage; our @ISA = ('Getopt::Long::Descriptive'); sub usage_class { 'CLI::Osprey::Descriptive::Usage' } 1; __END__ =pod =encoding UTF-8 =head1 NAME CLI::Osprey::Descriptive - Getopt::Long::Descriptive subclass for CLI::Osprey use =head1 VERSION version 0.09 =head1 DESCRIPTION This class overrides L's C method to L, which provides customized help text. You probably don't need to use it yourself. =head1 AUTHOR Andrew Rodland =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2025 by Andrew Rodland. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Basic000755001750001750 015105372346 17526 5ustar00andrewandrew000000000000CLI-Osprey-0.09/t/lib/MyTest/ClassYell.pm100644001750001750 356015105372346 21135 0ustar00andrewandrew000000000000CLI-Osprey-0.09/t/lib/MyTest/Class/Basicpackage MyTest::Class::Basic::Yell; use Moo; use CLI::Osprey; option excitement_level => ( is => 'ro', format => 'i', doc => 'Level of excitement for yelling', default => 0, ); # Example of underscored attribute name with short option that doesn't match first letter # Tests the fix where option name becomes 'output-format' (hyphenated) option output_format => ( is => 'ro', format => 's', short => 'f', # Note: 'f' not 'o' - doesn't match first letter doc => 'Output format (text, json, xml)', default => 'text', ); # Another example with short option matching first letter option repeat_count => ( is => 'ro', format => 'i', short => 'r', # Matches first letter of long option name doc => 'Number of times to repeat the yell', default => 1, ); # Test with completely different option name from attribute option custom_suffix => ( is => 'ro', format => 's', option => 'add-suffix', # Completely different from attribute name! short => 's', doc => 'Custom suffix to add to output', default => '', ); # Negatable boolean option - no format! option add_tag => ( is => 'ro', negatable => 1, doc => 'Add tag to output', default => 0, ); sub run { my ($self) = @_; my $message = uc $self->parent_command->message . "!" x $self->excitement_level; # Add custom suffix if provided $message .= $self->custom_suffix if $self->custom_suffix; for (1 .. $self->repeat_count) { my $output; if ($self->output_format eq 'json') { $output = qq({"yell": "$message"}); } elsif ($self->output_format eq 'xml') { $output = qq($message); } else { $output = $message; } if ($self->add_tag) { print "[TAG] $output\n"; } else { print "$output\n"; } } } 1; InlineSubcommand.pm100644001750001750 226315105372346 21570 0ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLI/Ospreypackage CLI::Osprey::InlineSubcommand; use strict; use warnings; use Moo; # ABSTRACT: A class to wrap coderef subcommands our $VERSION = '0.09'; # VERSION our $AUTHORITY = 'cpan:ARODLAND'; # AUTHORITY has 'name' => ( is => 'ro', required => 1, ); has 'desc' => ( is => 'bare', reader => '_osprey_subcommand_desc', ); has 'method' => ( is => 'ro', required => 1, ); has 'parent_command' => ( is => 'rw', ); has 'argv' => ( is => 'rw', ); sub new_with_options { my ($self, %args) = @_; $self->parent_command($args{ parent_command }); $self->argv([ @ARGV ]); return $self; } sub run { my ($self) = @_; my $cmd = $self->parent_command; my $method = $self->method; @_ = ($self->parent_command, @{ $self->argv }); goto &$method; } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME CLI::Osprey::InlineSubcommand - A class to wrap coderef subcommands =head1 VERSION version 0.09 =head1 AUTHOR Andrew Rodland =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2025 by Andrew Rodland. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Descriptive000755001750001750 015105372346 20121 5ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLI/OspreyUsage.pm100644001750001750 1671415105372346 21714 0ustar00andrewandrew000000000000CLI-Osprey-0.09/lib/CLI/Osprey/Descriptivepackage CLI::Osprey::Descriptive::Usage; use strict; use warnings; use Moo; use overload ( q{""} => "text", ); use Getopt::Long::Descriptive::Usage (); *option_text = \&Getopt::Long::Descriptive::Usage::option_text; # ABSTRACT: Produce usage information for CLI::Osprey apps our $VERSION = '0.09'; # VERSION our $AUTHORITY = 'cpan:ARODLAND'; # AUTHORITY my %format_doc = ( s => { short => "string", long => "string" }, i => { short => "int" , long => "integer" }, o => { short => "int" , long => "integer (dec/hex/bin/oct)" }, f => { short => "num" , long => "number" }, ); has 'options' => ( is => 'ro', ); has 'leader_text' => ( is => 'ro', ); has 'target' => ( is => 'ro', predicate => 1, ); has 'prog_name' => ( is => 'ro', predicate => 1, ); has 'width' => ( is => 'ro', default => sub { return $ENV{CLI_OSPREY_OVERRIDE_WIDTH} if exists $ENV{CLI_OSPREY_OVERRIDE_WIDTH}; return $ENV{COLUMNS} if exists $ENV{COLUMNS}; return 80; }, ); sub wrap { my ($self, $in, $prefix) = @_; my $width = $self->width; return $in if $width <= 0; my @out; my $line = ""; while ($in =~ /(\s*)(\S+)/g) { my ($space, $nonspace) = ($1, $2); if (length($line) + length($space) + length($nonspace) <= $width) { $line .= $space . $nonspace; } else { while (length($nonspace)) { push @out, $line; $line = $prefix; $line .= substr($nonspace, 0, $width - length($line), ''); } } } push @out, $line if length($line); return @out; } sub maxlen { my $max = 0; for (@_) { $max = length($_) if length($_) > $max; } return $max; } sub sub_commands_text { my ($self, $length) = @_; if ($self->has_target && (my %subcommands = $self->target->_osprey_subcommands)) { if ($length eq 'long') { my $maxlen = maxlen(keys %subcommands); my @out; push @out, ""; push @out, "Subcommands available:"; for my $name (sort keys %subcommands) { my $desc = $subcommands{$name}->can('_osprey_subcommand_desc') && $subcommands{$name}->_osprey_subcommand_desc; if (defined $desc) { push @out, $self->wrap( sprintf("%*s %s", -$maxlen, $name, $subcommands{$name}->_osprey_subcommand_desc), " " x ($maxlen + 2) ); } else { push @out, $name; } } push @out, ""; return @out; } else { return "", $self->wrap( "Subcommands available: " . join(" | ", sort keys %subcommands), " " x length("Subcommands available: ") ); } } return; } sub pod_escape { my ($self, $text) = @_; my %map = ( '<' => 'lt', '>' => 'gt', '|' => 'verbar', '/' => 'sol', ); $text =~ s,([<>|/]),"E<$map{$1}>",eg; return $text; } sub describe_opt { my ($self, $opt) = @_; if ($opt->{desc} eq 'spacer') { return { spacer => 1 }; } my $name = my $attr_name = $opt->{name}; my $option_attrs; if ($self->has_target) { my %options = $self->target->_osprey_options; $option_attrs = $options{$attr_name}; $name = $option_attrs->{option} if defined $option_attrs->{option}; } my ($short, $format) = $opt->{spec} =~ /(?:\|(\w))?(?:=(.*?))?$/; my $array; if (defined $format && $format =~ s/[\@\+]$//) { $array = 1; } my $format_doc; if (defined $format) { if (defined $option_attrs->{format_doc}) { $format_doc = { short => $option_attrs->{format_doc}, long => $option_attrs->{format_doc}, }; } else { $format_doc = $format_doc{$format}; } } my $spec; if ($short) { $spec = "-$short|"; } if (length($name) > 1) { $spec .= "--$name"; } else { $spec .= "-$name"; } my ($shortspec, $longspec) = ($spec, $spec); my ($podshortspec, $podlongspec) = ("B<< $spec >>", "B<< $spec >>"); if (defined $format_doc) { $shortspec .= " $format_doc->{short}"; $podshortspec .= " I<< $format_doc->{short} >>"; $longspec .= " $format_doc->{long}"; $podlongspec .= " I<< $format_doc->{long} >>"; } if ($array) { $shortspec .= "..."; $podshortspec .= "..."; } if (defined $option_attrs && !$option_attrs->{required}) { $shortspec = "[$shortspec]"; $podshortspec = "[$podshortspec]"; } return { short => $shortspec, long => $longspec, podshort => $podshortspec, podlong => $podlongspec, doc => $opt->{desc}, long_doc => defined($option_attrs->{long_doc}) ? $option_attrs->{long_doc} : $self->pod_escape($opt->{desc}), }; } sub describe_options { my ($self) = @_; return map $self->describe_opt($_), @{ $self->options }; } sub header { my ($self) = @_; my @descs = $self->describe_options; my $option_text = join "\n", $self->wrap( join(" ", map $_->{short}, grep !$_->{spacer}, @descs), " ", ); my $text = $self->leader_text; $text =~ s/\Q[long options...]/$option_text/; return $text; } sub text { my ($self) = @_; return join "\n", $self->header, $self->sub_commands_text('short'); } sub option_help { my ($self) = @_; my @descs = $self->describe_options; my $maxlen = maxlen(map $_->{long}, grep !$_->{spacer}, @descs); my @out; for my $desc (@descs) { if ($desc->{spacer}) { push @out, ""; } else { push @out, $self->wrap( sprintf("%*s %s", -$maxlen, $desc->{long}, $desc->{doc}), " " x ($maxlen + 2), ); } } return join("\n", $self->header, $self->sub_commands_text('long'), @out); } sub option_pod { my ($self) = @_; my %osprey_config = $self->target->_osprey_config; my @descs = $self->describe_options; my @pod; push @pod, "=encoding UTF-8"; push @pod, "=head1 NAME"; push @pod, $self->{prog_name} . ($osprey_config{desc} ? " - " . $osprey_config{desc} : "" ); push @pod, "=head1 SYNOPSIS"; push @pod, "B<< $self->{prog_name} >> " . join(" ", map "S<<< $_->{podshort} >>>", grep !$_->{spacer}, @descs); if ($osprey_config{description_pod}) { push @pod, "=head1 DESCRIPTION"; push @pod, $osprey_config{description_pod}; } if ($osprey_config{extra_pod}) { push @pod, $osprey_config{extra_pod}; } push @pod, "=head1 OPTIONS"; push @pod, "=over"; for my $desc (@descs) { if ($desc->{spacer}) { push @pod, "=back"; push @pod, "E<32>" x 40; push @pod, "=over"; } else { push @pod, "=item $desc->{podlong}"; push @pod, $desc->{long_doc}; } } push @pod, "=back"; if ($self->has_target && (my %subcommands = $self->target->_osprey_subcommands)) { push @pod, "=head1 COMMANDS"; push @pod, "=over"; for my $name (sort keys %subcommands) { my $desc = $subcommands{$name}->can('_osprey_subcommand_desc') && $subcommands{$name}->_osprey_subcommand_desc; push @pod, "=item B<< $name >>"; if ($desc) { push @pod, $desc; } } push @pod, "=back"; } return join("\n\n", @pod); } sub die { my $self = shift; my $arg = shift || {}; die( join q{}, grep { defined } $arg->{pre_text}, $self->text, $arg->{post_text} ); } sub warn { warn shift->text } 1; __END__ =pod =encoding UTF-8 =head1 NAME CLI::Osprey::Descriptive::Usage - Produce usage information for CLI::Osprey apps =head1 VERSION version 0.09 =head1 AUTHOR Andrew Rodland =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2025 by Andrew Rodland. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut