MooX-Cmd-0.015/000755 000765 000024 00000000000 12532043710 013041 5ustar00snostaff000000 000000 MooX-Cmd-0.015/Changes000644 000765 000024 00000007761 12532043632 014352 0ustar00snostaff000000 000000 Revision history for Perl module MooX::Cmd 0.015 2015-05-29 - fix breaking tests on Win32 due stacked Capture::Tiny::_capture_tee (thanks Alexandr Ciornii for reporting) 0.014 2015-05-27 - switching from IO::TieCombine to stacked Capture::Tiny in MooX::Cmd::Tester to avoid breaking commands in test (only) when relying on fileno of STD{OUT,ERR} 0.013 2015-03-04 - fix repository path's (reported by haarg) - fix ConfigFromFile test for Moose 0.012 2015-03-03 - add support for MooX::ConfigFromFile (0.006+) - improve initialization by using List::MoreUtils combo-functions instead of puzzling with List::Util - improve test coverage 0.011 2014-12-03 - apply clean Perl::Tidy rules to avoid mixed spaces/tabs and other settings - add version number to MooX::Cmd::Tester - allow overriding protected constructor when renaming public one 0.010 2014-12-02 - switch distribution tooling from Dist::Zilla to ExtUtils::MakeMaker - Added Changes file with content based on git log according to CPAN::Changes::Spec (Neil Bowers) - Apply typo fixes for documentation from David Steinbrunner - Sven Schober provided heavily improved description 0.009 2014-02-08 - Apply submitted fix for RT#91481 - without test .. - fix RT#91500 - incorrect execute_return if ... The implication was wrong, indeed - but the effort was increadible. Testing sucks :P - distinguish between test_cmd and test_cmd_ok - after chained constructor, we can use getters - add missing prereqs 0.008 2013-11-13 - groundwork for testing with Mo(o(se)) - add THANKS section - final test for MooX::Options 3.99 - eliminate hidden/private __moox_cmd_chain param - massively increase test coverage 0.007 2013-11-07 - improve test coverage of MooX::Cmd::Role - 100% test coverage of MooX::Cmd - add some documentation for MooX::Cmd::Tester - ignore editor temp files and backup files - enhance and fix tests - Adopt basic tests using tester API - steal some code from App::Cmd::Tester and adopt Basic test infrastructure ... needs fine tuning, but first steps are done that way. - BAIL_OUT when unable to load MooX::Cmd No further testing possible nor reasonable 0.006001 2013-11-06 - remove superfluous "my" causing undef command_name 0.006 2013-11-05 - Merge github.com:rehsack/MooX-Cmd 0.005 2013-11-05 - Merge github.com:Getty/p5-moox-cmd into rehsack - correct content of command_name attribute - Merge github.com:Getty/p5-moox-cmd 0.004 2013-11-02 - New travis config - Add some comfort as primary author desires To avoid scaring users the Getty wants some improved examples and an accessor for last cmd in chain. - Add some samples to role author wants ('examples') x INT_MAX - unfortunately he gets only one - Move initialization to MooX::Cmd::Role - Improve documentation - Allow Class->new_with_cmd->execute(...) - Move initialization sequence for cmd into role As discussed with primary author, a role having all neat information about the cmd state in attributes is smarter that passing arguments ... - Simplify loading commands to avoid stack frames - Remove trailing \t - Some safety first checks and minor optimizations - Allow commands show available neighbours/children - Merge github.com:Getty/p5-moox-cmd - Merge pull request #2 from yanick/master only load commands if used - Bump Module::Pluggable version to stop 5.18 from whining and let it work smoothly on blead 0.003 2013-04-20 - Switched to Author::GETTY, added .travis.yml - Don't load commands unless they are used This should make things much more zippy if we have more than a handful of commands. 0.002 2012-05-07 - Added requirement for Package::Stash - Added documentation (hope it works ;) as told hehe) and use of Package::Stash 0.001 2012-02-10 - First release to CPAN MooX-Cmd-0.015/etc/000755 000765 000024 00000000000 12532043707 013622 5ustar00snostaff000000 000000 MooX-Cmd-0.015/lib/000755 000765 000024 00000000000 12532043707 013615 5ustar00snostaff000000 000000 MooX-Cmd-0.015/Makefile.PL000644 000765 000024 00000011233 12531025720 015013 0ustar00snostaff000000 000000 use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my %RUN_DEPS = ( "Carp" => 0, "List::MoreUtils" => 0.406, "Moo" => "0.009013", "Module::Pluggable" => "4.8", "Module::Runtime" => 0, "Package::Stash" => "0.33", "Params::Util" => "0.37", "Regexp::Common" => "2011121001", "Scalar::Util" => 0, "Text::ParseWords" => 0, ); my %CONFIGURE_DEPS = ( 'ExtUtils::MakeMaker' => 0, ); my %BUILD_DEPS = (); my %TEST_DEPS = ( "Test::More" => 0.98, "Capture::Tiny" => 0, ); WriteMakefile1( MIN_PERL_VERSION => '5.008001', META_ADD => { 'meta-spec' => { version => 2 }, resources => { homepage => 'https://metacpan.org/release/MooX-Cmd', repository => { url => 'https://github.com:Getty/p5-moox-cmd.git', web => 'https://github.com/Getty/p5-moox-cmd', type => 'git', }, bugtracker => { web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=MooX-Cmd', mailto => 'bug-MooX-Cmd@rt.cpan.org', }, license => 'http://dev.perl.org/licenses/', }, prereqs => { develop => { requires => { 'Test::CPAN::Changes' => 0, 'Test::CheckManifest' => 0, 'Module::CPANTS::Analyse' => '0.96', 'Test::Kwalitee' => 0, 'Test::Pod' => 0, 'Test::Pod::Coverage' => 0, 'Test::Pod::Spelling::CommonMistakes' => 0, 'Test::Spelling' => 0, }, }, configure => { requires => {%CONFIGURE_DEPS}, }, build => { requires => {%BUILD_DEPS} }, test => { requires => {%TEST_DEPS} }, runtime => { requires => { %RUN_DEPS, perl => '5.8.1', }, }, }, }, NAME => 'MooX::Cmd', VERSION_FROM => 'lib/MooX/Cmd.pm', ABSTRACT_FROM => 'lib/MooX/Cmd.pm', LICENSE => 'perl', AUTHOR => [ q{Jens Rehsack }, q{Torsten Raudssus } ], PREREQ_PM => \%RUN_DEPS, CONFIGURE_REQUIRES => \%CONFIGURE_DEPS, BUILD_REQUIRES => \%BUILD_DEPS, TEST_REQUIRES => \%TEST_DEPS, test => { TESTS => 't/*.t xt/*.t' }, ); sub WriteMakefile1 { # originally written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params = @_; my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version = eval $eumm_version; die "EXTRA_META is deprecated" if ( exists( $params{EXTRA_META} ) ); die "License not specified" if ( !exists( $params{LICENSE} ) ); $params{TEST_REQUIRES} and $eumm_version < 6.6303 and $params{BUILD_REQUIRES} = { %{ $params{BUILD_REQUIRES} || {} }, %{ delete $params{TEST_REQUIRES} } }; #EUMM 6.5502 has problems with BUILD_REQUIRES $params{BUILD_REQUIRES} and $eumm_version < 6.5503 and $params{PREREQ_PM} = { %{ $params{PREREQ_PM} || {} }, %{ delete $params{BUILD_REQUIRES} } }; ref $params{AUTHOR} and "ARRAY" eq ref $params{AUTHOR} and $eumm_version < 6.5702 and $params{AUTHOR} = join( ", ", @{ $params{AUTHOR} } ); delete $params{CONFIGURE_REQUIRES} if ( $eumm_version < 6.52 ); delete $params{MIN_PERL_VERSION} if ( $eumm_version < 6.48 ); delete $params{META_MERGE} if ( $eumm_version < 6.46 ); delete $params{META_ADD}{prereqs} if ( $eumm_version < 6.58 ); delete $params{META_ADD}{'meta-spec'} if ( $eumm_version < 6.58 ); delete $params{META_ADD} if ( $eumm_version < 6.46 ); delete $params{LICENSE} if ( $eumm_version < 6.31 ); delete $params{AUTHOR} if ( $] < 5.005 ); delete $params{ABSTRACT_FROM} if ( $] < 5.005 ); delete $params{BINARY_LOCATION} if ( $] < 5.005 ); # more or less taken from Moose' Makefile.PL if ( $params{CONFLICTS} ) { my $ok = CheckConflicts(%params); exit(0) if ( $params{PREREQ_FATAL} and not $ok ); my $cpan_smoker = grep { $_ =~ m/(?:CR_SMOKER|CPAN_REPORTER|AUTOMATED_TESTING)/ } keys %ENV; unless ( $cpan_smoker || $ENV{PERL_MM_USE_DEFAULT} ) { sleep 4 unless ($ok); } delete $params{CONFLICTS}; } WriteMakefile(%params); } MooX-Cmd-0.015/MANIFEST000644 000765 000024 00000002143 12532043710 014172 0ustar00snostaff000000 000000 Changes etc/04-moox-configfromfile.t-check-it.json etc/04-moox-configfromfile.t-check.json etc/04-moox-configfromfile.t.json lib/MooX/Cmd.pm lib/MooX/Cmd/Role.pm lib/MooX/Cmd/Role/ConfigFromFile.pm lib/MooX/Cmd/Tester.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README.md t/00-load.t t/01-simple.t t/02-moox-options.t t/03-params.t t/04-moox-configfromfile.t t/lib/ConfigApp.pm t/lib/ConfigApp/Cmd/Check.pm t/lib/ConfigApp/Cmd/Check/Cmd/It.pm t/lib/FailTestApp.pm t/lib/FailTestApp/Cmd/nocreatable.pm t/lib/FailTestApp/Cmd/nothing.pm t/lib/FailTestApp/Cmd/uncreatable.pm t/lib/FirstTestApp.pm t/lib/FirstTestApp/Cmd/Test.pm t/lib/FirstTestApp/Cmd/Test/Cmd/Test.pm t/lib/OptionTestApp.pm t/lib/OptionTestApp/Cmd/Oops.pm t/lib/OptionTestApp/Cmd/primary.pm t/lib/OptionTestApp/Cmd/primary/Cmd/secondary.pm t/lib/SecondTestApp.pm t/lib/SecondTestApp/Cmd/cwo.pm t/lib/SecondTestApp/Cmd/ifc.pm t/lib/ThirdTestApp.pm t/lib/ThirdTestApp/Cmd/Foo.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) MooX-Cmd-0.015/MANIFEST.SKIP000644 000765 000024 00000000473 12475104312 014745 0ustar00snostaff000000 000000 \B\.svn\b \B\.git\b \.gitignore$ \.[Bb][Aa][Kk]$ \.orig$ \.old$ \.tdy$ \.tmp$ \..*swp ^Makefile$ ^Build$ ^Build\.bat$ \.Inline/.* _Inline/.* \.bak$ \.tar$ \.tgz$ \.tar\.gz$ ^mess/ ^tmp/ ^testdata/ ^blib/ ^sandbox/ ^pm_to_blib$ ^cover_db/ ^_build/.* ~$ .*\.planner ^\..* MooX-Cmd-.* \bxt ^MYMETA\.json$ ^MYMETA\..*$ MooX-Cmd-0.015/META.json000644 000765 000024 00000004353 12532043710 014467 0ustar00snostaff000000 000000 { "abstract" : "Giving an easy Moo style way to make command organized CLI apps", "author" : [ "Jens Rehsack ", "Torsten Raudssus " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "MooX-Cmd", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Module::CPANTS::Analyse" : "0.96", "Test::CPAN::Changes" : "0", "Test::CheckManifest" : "0", "Test::Kwalitee" : "0", "Test::Pod" : "0", "Test::Pod::Coverage" : "0", "Test::Pod::Spelling::CommonMistakes" : "0", "Test::Spelling" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "List::MoreUtils" : "0.406", "Module::Pluggable" : "4.8", "Module::Runtime" : "0", "Moo" : "0.009013", "Package::Stash" : "0.33", "Params::Util" : "0.37", "Regexp::Common" : "2011121001", "Scalar::Util" : "0", "Text::ParseWords" : "0", "perl" : "v5.8.1" } }, "test" : { "requires" : { "Capture::Tiny" : "0", "Test::More" : "0.98" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-MooX-Cmd@rt.cpan.org", "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=MooX-Cmd" }, "homepage" : "https://metacpan.org/release/MooX-Cmd", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com:Getty/p5-moox-cmd.git", "web" : "https://github.com/Getty/p5-moox-cmd" } }, "version" : "0.015" } MooX-Cmd-0.015/META.yml000644 000765 000024 00000002025 12532043710 014311 0ustar00snostaff000000 000000 --- abstract: 'Giving an easy Moo style way to make command organized CLI apps' author: - 'Jens Rehsack ' - 'Torsten Raudssus ' build_requires: Capture::Tiny: '0' Test::More: '0.98' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MooX-Cmd no_index: directory: - t - inc requires: Carp: '0' List::MoreUtils: '0.406' Module::Pluggable: '4.8' Module::Runtime: '0' Moo: '0.009013' Package::Stash: '0.33' Params::Util: '0.37' Regexp::Common: '2011121001' Scalar::Util: '0' Text::ParseWords: '0' perl: v5.8.1 resources: bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=MooX-Cmd homepage: https://metacpan.org/release/MooX-Cmd license: http://dev.perl.org/licenses/ repository: https://github.com:Getty/p5-moox-cmd.git version: '0.015' MooX-Cmd-0.015/README.md000644 000765 000024 00000002732 12437072717 014341 0ustar00snostaff000000 000000 ## Name MooX::Cmd - Giving an easy Moo style way to make command organized CLI apps ## Description Eases the writing of command line utilities, accepting commands and subcommands and so on. These commands can form a tree, which is mirrored in the package structure. On invocation each command along the path through the tree (starting from the toplevel command through to the most specific one) is instanciated. ## Author Torsten Raudssus, "" Jens Rehsack, "" ## BUGS Please report any bugs or feature requests to "bug-moox-cmd at rt.cpan.org", or through the web interface at . I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. ## Support Repository http://github.com/Getty/p5-moox-cmd Pull request and additional contributors are welcome Issue Tracker http://github.com/Getty/p5-moox-cmd/issues http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooX-Cmd bug-moox-cmd at rt.cpan.org ## License And Copyright Copyright 2012-2013 Torsten Raudssus, Copyright 2013-2014 Jens Rehsack. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See for more information. MooX-Cmd-0.015/t/000755 000765 000024 00000000000 12532043707 013312 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/00-load.t000644 000765 000024 00000000576 12437066103 014642 0ustar00snostaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; my $moodel; BEGIN { $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; use_ok('MooX::Cmd') || BAIL_OUT("Couldn't load MooX::Cmd"); } diag( "Testing MooX::Cmd $MooX::Cmd::VERSION, $moodel " . $moodel->VERSION . ", Perl $], $^X" ); done_testing; MooX-Cmd-0.015/t/01-simple.t000644 000765 000024 00000004215 12437066103 015207 0ustar00snostaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use MooX::Cmd::Tester; use FindBin qw($Bin); use lib "$Bin/lib"; use FirstTestApp; use SecondTestApp; use ThirdTestApp; use FailTestApp; my @tests = ( [ 'test', [ "FirstTestApp::Cmd::Test", [], [ "FirstTestApp" ] ] ], [ 'test test', [ "FirstTestApp::Cmd::Test::Cmd::Test", [], [ "FirstTestApp","FirstTestApp::Cmd::Test" ] ] ], [ 'test this', [ "FirstTestApp::Cmd::Test", [ "this" ], [ "FirstTestApp" ] ] ], [ 'this test test this', [ "FirstTestApp::Cmd::Test::Cmd::Test", [ "this" ], [ "FirstTestApp","FirstTestApp::Cmd::Test" ] ] ], [ 'test this test', [ "FirstTestApp::Cmd::Test::Cmd::Test", [], [ "FirstTestApp","FirstTestApp::Cmd::Test" ] ] ], [ 'ifc', [ "SecondTestApp::Cmd::ifc", [], [ "SecondTestApp" ] ] ], [ 'cwo', [ "SecondTestApp::Cmd::cwo", [], [ "SecondTestApp" ] ] ], ); for (@tests) { my ( $args, $result ) = @{$_}; ref $args or $args = [split(' ', $args)]; my $rv = test_cmd_ok( $result->[2]->[0] => $args ); # my $app = FirstTestApp->new_with_cmd; # isa_ok($app,'FirstTestApp'); #my @execute_return = @{$app->execute_return}; "ARRAY" eq ref $rv->execute_rv or diag(explain($rv)); my @execute_return = @{$rv->execute_rv}; my @moox_cmd_chain = map { ref $_ } @{$execute_return[2]}; push @{$result->[2]}, $result->[0]; my $execute_result = [ref $execute_return[0],$execute_return[1],\@moox_cmd_chain]; is_deeply($execute_result,$result,'Checking result of "'.join(" ", @$args).'"'); } { my $rv = test_cmd_ok( ThirdTestApp => [qw(foo)] ); my $nothing; is_deeply(\$nothing,\$rv->{execute_return},'Checking result of "ThirdTestApp => [foo]"'); } { my $rv = test_cmd( FailTestApp => [qw(nothing)] ); like( $rv->error, qr/need.*execute.*nothing/, "Load fails for FailTestApp => [nothing]" ); } { my $rv = test_cmd( FailTestApp => [qw(uncreatable)] ); like( $rv->error, qr/Can't find a creation method/, "Load fails for FailTestApp => [nothing]" ); } { my $rv = test_cmd( FailTestApp => [qw(nocreatable)] ); like( $rv->error, qr/Can't find a creation method/, "Load fails for FailTestApp => [nothing]" ); } done_testing; MooX-Cmd-0.015/t/02-moox-options.t000644 000765 000024 00000003363 12437066103 016375 0ustar00snostaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use Moo; use MooX::Cmd::Tester; use FindBin qw($Bin); use lib "$Bin/lib"; BEGIN { eval "use MooX::Options 3.99; use OptionTestApp"; $@ and plan skip_all => "Need MooX::Options 3.99 $@" and exit(0); } my @tests = ( [ [ qw(--help) ], "OptionTestApp", [], qr{\QUSAGE: 02-moox-options.t [-h]\E}, qr{\QSUB COMMANDS AVAILABLE: \E(?:oops|primary)} ], [ [ qw(--in-doubt) ], "OptionTestApp", [ qw(OptionTestApp) ] ], [ [ qw(primary --help) ], "OptionTestApp", [], qr{\QUSAGE: 02-moox-options.t primary [-h]\E}, qr{\QSUB COMMANDS AVAILABLE: secondary\E} ], [ [ qw(primary --serious) ], "OptionTestApp", [ qw(OptionTestApp OptionTestApp::Cmd::primary) ] ], [ [ qw(--in-doubt primary secondary --help) ], "OptionTestApp", [], qr{\QUSAGE: 02-moox-options.t primary secondary [-h]\E} ], [ [ qw(primary secondary --sure) ], "OptionTestApp", [ qw(OptionTestApp OptionTestApp::Cmd::primary OptionTestApp::Cmd::primary::Cmd::secondary) ] ], ); for (@tests) { my ( $args, $class, $chain, $help, $avail ) = @{$_}; ref $args or $args = [split(' ', $args)]; my $rv = test_cmd( $class => $args ); my $test_ident = "$class => " . join(" ", "[", @$args, "]"); $help and like( $rv->stdout, $help, "test '$test_ident' help message" ); $help or unlike( $rv->stdout, qr{\QUSAGE: 02-moox-options.t\E}, "test '$test_ident' no help message" ); $avail and like( $rv->stdout, $avail, "test '$test_ident' avail commands ok" ); $avail or unlike( $rv->stdout, qr{\QAvailable commands\E}, "test '$test_ident' no avail commands" ); if(defined($rv->cmd)) { my @cmd_chain = map { ref $_ } @{$rv->cmd->command_chain}; is_deeply(\@cmd_chain, $chain, "test '$test_ident' command chain ok"); } } done_testing; MooX-Cmd-0.015/t/03-params.t000644 000765 000024 00000006251 12437066103 015205 0ustar00snostaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use MooX::Cmd::Tester; use FindBin qw($Bin); use lib "$Bin/lib"; use FirstTestApp; use SecondTestApp; use ThirdTestApp; { local @ARGV; my $cmd = SecondTestApp->new_with_cmd(command_execute_method_name => "run"); my $rv = test_cmd_ok( $cmd, [] ); my @execute_return = @{$rv->execute_rv}; is_deeply(\@execute_return,[$cmd],'Checking result of "SecondTestApp(command_base => "SecondTestApp::Cmd") => []"'); } { local @ARGV; my $cmd = SecondTestApp->new_with_cmd(command_base => "SecondTestApp::Cmd"); my $rv = test_cmd_ok( $cmd, [] ); my @execute_return = @{$rv->execute_rv}; is_deeply(\@execute_return,[$cmd],'Checking result of "SecondTestApp(command_base => "SecondTestApp::Cmd") => []"'); } { local @ARGV; my $cmd = SecondTestApp->new_with_cmd(command_creation_chain_methods => "new"); my $rv = test_cmd_ok( $cmd, [] ); my @execute_return = @{$rv->execute_rv}; is_deeply(\@execute_return,[$cmd],'Checking result of "SecondTestApp(command_creation_chain_methods => "new") => []"'); } { local @ARGV; my $cmd = SecondTestApp->new_with_cmd(command_commands => {ifc => "SecondTestApp::Cmd::ifc", cwo => "SecondTestApp::Cmd::cwo"}); my $rv = test_cmd_ok( $cmd, [] ); my @execute_return = @{$rv->execute_rv}; is_deeply(\@execute_return,[$cmd],'Checking result of "SecondTestApp(command_commands => {ifc => "SecondTestApp::Cmd::ifc", cwo => "SecondTestApp::Cmd::cwo"}) => []"'); } { local @ARGV; my $cmd = SecondTestApp->new_with_cmd(command_base => "SecondTestApp::Cmd", command_creation_chain_methods => "new"); my $rv = test_cmd_ok( $cmd, [] ); my @execute_return = @{$rv->execute_rv}; is_deeply(\@execute_return,[$cmd],'Checking result of "SecondTestApp(command_base => "SecondTestApp::Cmd") => []"'); } { local @ARGV = qw(foo); my $cmd = ThirdTestApp->new_with_cmd(command_execute_from_new => undef); my $rv = test_cmd_ok( $cmd, [qw(foo)] ); is($rv->execute_rv,undef,'Checking result of "ThirdTestApp(command_execute_from_new => undef) => []"'); } { local @ARGV = qw(foo); my $cmd = ThirdTestApp->new_with_cmd(command_execute_from_new => 0); my $rv = test_cmd_ok( $cmd, [qw(foo)] ); is_deeply($rv->execute_rv,undef,'Checking result of "ThirdTestApp(command_execute_from_new => 0) => []"'); } { local @ARGV; my $cmd = SecondTestApp->new_with_cmd(command_execute_return_method_name => "was_haste"); my $rv = test_cmd_ok( $cmd, [] ); my @execute_return = @{$rv->execute_rv}; is_deeply(\@execute_return,[$cmd],'Checking result of "SecondTestApp(command_execute_return_method_name => "was_haste") => []"'); } { local @ARGV; eval { my $cmd = SecondTestApp->new_with_cmd(command_creation_chain_methods => "search_me"); }; like( $@, qr/Can't find a creation method on/, 'Load fails for SecondTestApp(command_creation_chain_methods => "search_me") => []' ); } SKIP: { eval "use OptionTestApp;"; $@ and skip("MooX::Options required", 1); local @ARGV = qw(oops); my $cmd = eval { OptionTestApp->new_with_cmd(command_creation_chain_methods => "new_with_options"); }; like( $@, qr/Can't find a creation method on/, 'Load fails for OptionTestApp(command_creation_chain_methods => "new_with_options") => []' ); } done_testing; MooX-Cmd-0.015/t/04-moox-configfromfile.t000644 000765 000024 00000003221 12475353356 017701 0ustar00snostaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use Moo; use MooX::Cmd::Tester; use FindBin qw($Bin); use lib "$Bin/lib"; BEGIN { eval "use MooX::ConfigFromFile 0.006; use ConfigApp"; $@ and plan skip_all => "Need MooX::ConfigFromFile 0.006 -- $@" and exit(0); } my @tests = ( [ [], "ConfigApp", "ConfigApp", { complicated_setting => { say => "Hello!" } } ], [ [qw(check)], "ConfigApp", "ConfigApp::Cmd::Check", { unintialized_attribute => sub { time - $_[0] < 1 } } ], [ [qw(check it)], "ConfigApp", "ConfigApp::Cmd::Check::Cmd::It", { dedicated_setting => 1 } ], ); SKIP: for (@tests) { my ( $args, $class, $cmd_class, $attrs ) = @{$_}; ref $args or $args = [ split( ' ', $args ) ]; my $rv = test_cmd( $class => $args ); #diag(explain($rv)); my $test_ident = "$class => " . join( " ", "[", @$args, "]" ); ok( $rv->cmd, "got cmd for $test_ident" ) or diag(explain($rv)); isa_ok( $rv->cmd, $class ) or skip( "Cannot do attribute testing without command", 2 ); isa_ok( $rv->cmd->command_chain_end, $cmd_class ) or skip( "Cannot do attribute testing without specific command", 1 ) if scalar @$args; my $cmd = scalar @$args ? $rv->cmd->command_chain_end : $rv->cmd; foreach my $k ( keys %$attrs ) { my $cmd_attr = $cmd->$k; ref $attrs->{$k} or is( $attrs->{$k}, $cmd_attr, "Attribute $k for $test_ident" ); "CODE" eq ref $attrs->{$k} and ok( $attrs->{$k}->($cmd_attr), "Attribute $k ok for $test_ident" ); ref $attrs->{$k} and "CODE" ne ref $attrs->{$k} and is_deeply( $attrs->{$k}, $cmd_attr, "Attribute $k for $test_ident" ); } } done_testing; MooX-Cmd-0.015/t/lib/000755 000765 000024 00000000000 12532043707 014060 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ConfigApp/000755 000765 000024 00000000000 12532043707 015726 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ConfigApp.pm000644 000765 000024 00000000451 12475350107 016265 0ustar00snostaff000000 000000 package ConfigApp; use strict; use warnings; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd with_config_from_file => 1; has complicated_setting => ( is => "ro", required => 1 ); sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/FailTestApp/000755 000765 000024 00000000000 12532043707 016234 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/FailTestApp.pm000644 000765 000024 00000000317 12437066103 016572 0ustar00snostaff000000 000000 package FailTestApp; use Moo; use MooX::Cmd execute_from_new => undef; around _build_command_execute_method_name => sub { "run" }; around _build_command_execute_from_new => sub { 0 }; sub run { @_ } 1; MooX-Cmd-0.015/t/lib/FirstTestApp/000755 000765 000024 00000000000 12532043707 016450 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/FirstTestApp.pm000644 000765 000024 00000000277 12437066103 017013 0ustar00snostaff000000 000000 package FirstTestApp; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd; sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/OptionTestApp/000755 000765 000024 00000000000 12532043707 016631 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/OptionTestApp.pm000644 000765 000024 00000000523 12437066103 017166 0ustar00snostaff000000 000000 package OptionTestApp; use strict; use warnings; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd execute_from_new => undef; use MooX::Options; option in_doubt => ( is => "ro", negativable => 1, doc => "in doubt?", ); sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/SecondTestApp/000755 000765 000024 00000000000 12532043707 016574 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/SecondTestApp.pm000644 000765 000024 00000000460 12437066103 017131 0ustar00snostaff000000 000000 package SecondTestApp; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd execute_from_new => 0; around _build_command_execute_method_name => sub { "run" }; sub run { @_ } sub was_haste { return $_[0]->{was_haste} } 1; MooX-Cmd-0.015/t/lib/ThirdTestApp/000755 000765 000024 00000000000 12532043707 016433 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ThirdTestApp.pm000644 000765 000024 00000000517 12437066103 016773 0ustar00snostaff000000 000000 package ThirdTestApp; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd execute_from_new => undef; around _build_command_execute_method_name => sub { "run" }; sub mach_mich_perwoll { goto \&MooX::Cmd::Role::_initialize_from_cmd; } sub run { @_ } 1; MooX-Cmd-0.015/t/lib/ThirdTestApp/Cmd/000755 000765 000024 00000000000 12532043707 017136 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ThirdTestApp/Cmd/Foo.pm000644 000765 000024 00000000334 12437066103 020216 0ustar00snostaff000000 000000 package ThirdTestApp::Cmd::Foo; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } sub _build_command_execute_method_name { "run" } sub run { @_ } 1; MooX-Cmd-0.015/t/lib/SecondTestApp/Cmd/000755 000765 000024 00000000000 12532043707 017277 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/SecondTestApp/Cmd/cwo.pm000644 000765 000024 00000000542 12437066103 020425 0ustar00snostaff000000 000000 package SecondTestApp::Cmd::cwo; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd execute_return_method_name => 'run_result', creation_method_name => "mach_mich_neu", execute_from_new => 1; around _build_command_execute_method_name => sub { "run" }; sub run { @_ } 1; MooX-Cmd-0.015/t/lib/SecondTestApp/Cmd/ifc.pm000644 000765 000024 00000000552 12437066103 020377 0ustar00snostaff000000 000000 package SecondTestApp::Cmd::ifc; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; __PACKAGE__->can("with")->("MooX::Cmd::Role"); } around _build_command_execute_method_name => sub { "run" }; around _build_command_execute_from_new => sub { 1 }; sub run { @_ } eval "use MooX::Cmd;"; 1; MooX-Cmd-0.015/t/lib/OptionTestApp/Cmd/000755 000765 000024 00000000000 12532043707 017334 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/OptionTestApp/Cmd/Oops.pm000644 000765 000024 00000000336 12437066103 020613 0ustar00snostaff000000 000000 package OptionTestApp::Cmd::Oops; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } sub _build_command_execute_method_name { "run" } sub run { @_ } 1; MooX-Cmd-0.015/t/lib/OptionTestApp/Cmd/primary/000755 000765 000024 00000000000 12532043707 021017 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/OptionTestApp/Cmd/primary.pm000644 000765 000024 00000000530 12437066103 021352 0ustar00snostaff000000 000000 package OptionTestApp::Cmd::primary; use strict; use warnings; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd; use MooX::Options; option serious => ( is => "ro", negativable => 1, required => 0, doc => "serious?", ); sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/OptionTestApp/Cmd/primary/Cmd/000755 000765 000024 00000000000 12532043707 021522 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/OptionTestApp/Cmd/primary/Cmd/secondary.pm000644 000765 000024 00000000542 12437066103 024047 0ustar00snostaff000000 000000 package OptionTestApp::Cmd::primary::Cmd::secondary; use strict; use warnings; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd; use MooX::Options; option sure => ( is => "ro", negativable => 1, required => 1, doc => "sure?", ); sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/FirstTestApp/Cmd/000755 000765 000024 00000000000 12532043707 017153 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/FirstTestApp/Cmd/Test/000755 000765 000024 00000000000 12532043707 020072 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/FirstTestApp/Cmd/Test.pm000644 000765 000024 00000000276 12475366406 020447 0ustar00snostaff000000 000000 package FirstTestApp::Cmd::Test; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd; sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/FirstTestApp/Cmd/Test/Cmd/000755 000765 000024 00000000000 12532043707 020575 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/FirstTestApp/Cmd/Test/Cmd/Test.pm000644 000765 000024 00000000272 12437066103 022052 0ustar00snostaff000000 000000 package FirstTestApp::Cmd::Test::Cmd::Test; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/FailTestApp/Cmd/000755 000765 000024 00000000000 12532043707 016737 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/FailTestApp/Cmd/nocreatable.pm000644 000765 000024 00000000230 12437066103 021546 0ustar00snostaff000000 000000 package FailTestApp::Cmd::nocreatable; use Moo; with "MooX::Cmd::Role"; around _build_command_creation_chain_methods => sub { }; sub execute {} 1; MooX-Cmd-0.015/t/lib/FailTestApp/Cmd/nothing.pm000644 000765 000024 00000000047 12437066103 020743 0ustar00snostaff000000 000000 package FailTestApp::Cmd::nothing; 1; MooX-Cmd-0.015/t/lib/FailTestApp/Cmd/uncreatable.pm000644 000765 000024 00000000233 12437066103 021557 0ustar00snostaff000000 000000 package FailTestApp::Cmd::uncreatable; use Moo; with "MooX::Cmd::Role"; around _build_command_creation_chain_methods => sub { [] }; sub execute {} 1; MooX-Cmd-0.015/t/lib/ConfigApp/Cmd/000755 000765 000024 00000000000 12532043707 016431 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ConfigApp/Cmd/Check/000755 000765 000024 00000000000 12532043707 017446 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ConfigApp/Cmd/Check.pm000644 000765 000024 00000000601 12475624232 020005 0ustar00snostaff000000 000000 package ConfigApp::Cmd::Check; use strict; use warnings; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd; has unintialized_attribute => ( is => "ro", builder => "_build_unintialized_attribute", lazy => 1 ); sub _build_unintialized_attribute { time } sub execute { @_ } 1; MooX-Cmd-0.015/t/lib/ConfigApp/Cmd/Check/Cmd/000755 000765 000024 00000000000 12532043707 020151 5ustar00snostaff000000 000000 MooX-Cmd-0.015/t/lib/ConfigApp/Cmd/Check/Cmd/It.pm000644 000765 000024 00000000474 12475353113 021071 0ustar00snostaff000000 000000 package ConfigApp::Cmd::Check::Cmd::It; use strict; use warnings; BEGIN { my $moodel = $ENV{WHICH_MOODEL} || "Moo"; eval "use $moodel;"; $@ and die $@; $moodel->import; } use MooX::Cmd with_config_from_file => 1; has dedicated_setting => ( is => "ro", required => 1 ); sub execute { @_ } 1; MooX-Cmd-0.015/lib/MooX/000755 000765 000024 00000000000 12532043707 014477 5ustar00snostaff000000 000000 MooX-Cmd-0.015/lib/MooX/Cmd/000755 000765 000024 00000000000 12532043707 015202 5ustar00snostaff000000 000000 MooX-Cmd-0.015/lib/MooX/Cmd.pm000644 000765 000024 00000023672 12532042662 015551 0ustar00snostaff000000 000000 package MooX::Cmd; use strict; use warnings; our $VERSION = "0.015"; use Package::Stash; sub import { my ( undef, %import_options ) = @_; my $caller = caller; my @caller_isa; { no strict 'refs'; @caller_isa = @{"${caller}::ISA"} }; #don't add this to a role #ISA of a role is always empty ! ## no critic qw/ProhibitStringyEval/ @caller_isa or return; my $execute_return_method_name = $import_options{execute_return_method_name}; exists $import_options{execute_from_new} or $import_options{execute_from_new} = 1; # set default until we want other way my $stash = Package::Stash->new($caller); defined $import_options{execute_return_method_name} and $stash->add_symbol( '&' . $import_options{execute_return_method_name}, sub { shift->{ $import_options{execute_return_method_name} } } ); defined $import_options{creation_method_name} or $import_options{creation_method_name} = "new_with_cmd"; $stash->add_symbol( '&' . $import_options{creation_method_name}, sub { shift->_initialize_from_cmd(@_); } ); my $apply_modifiers = sub { $caller->can('_initialize_from_cmd') and return; my $with = $caller->can('with'); $with->('MooX::Cmd::Role'); # XXX prove whether it can chained ... $import_options{with_config_from_file} and $with->('MooX::ConfigFromFile::Role'); $import_options{with_config_from_file} and $with->('MooX::Cmd::Role::ConfigFromFile'); }; $apply_modifiers->(); my %default_modifiers = ( base => '_build_command_base', execute_method_name => '_build_command_execute_method_name', execute_return_method_name => '_build_command_execute_return_method_name', creation_chain_methods => '_build_command_creation_chain_methods', creation_method_name => '_build_command_creation_method_name', execute_from_new => '_build_command_execute_from_new', ); my $around; foreach my $opt_key ( keys %default_modifiers ) { exists $import_options{$opt_key} or next; $around or $around = $caller->can('around'); $around->( $default_modifiers{$opt_key} => sub { $import_options{$opt_key} } ); } return; } 1; =encoding utf8 =head1 NAME MooX::Cmd - Giving an easy Moo style way to make command organized CLI apps =head1 SYNOPSIS package MyApp; use Moo; use MooX::Cmd; sub execute { my ( $self, $args_ref, $chain_ref ) = @_; my @extra_argv = @{$args_ref}; my @chain = @{$chain_ref} # in this case only ( $myapp ) # where $myapp == $self } 1; package MyApp::Cmd::Command; # for "myapp command" use Moo; use MooX::Cmd; # gets executed on "myapp command" but not on "myapp command command" # there MyApp::Cmd::Command still gets instantiated and for the chain sub execute { my ( $self, $args_ref, $chain_ref ) = @_; my @chain = @{$chain_ref} # in this case ( $myapp, $myapp_cmd_command ) # where $myapp_cmd_command == $self } 1; package MyApp::Cmd::Command::Cmd::Command; # for "myapp command command" use Moo; use MooX::Cmd; # gets executed on "myapp command command" and will not get instantiated # on "myapp command" cause it doesnt appear in the chain there sub execute { my ( $self, $args_ref, $chain_ref ) = @_; my @chain = @{$chain_ref} # in this case ( $myapp, $myapp_cmd_command, # $myapp_cmd_command_cmd_command ) # where $myapp_cmd_command_cmd_command == $self } package MyZapp; use Moo; use MooX::Cmd execute_from_new => 0; sub execute { my ( $self ) = @_; my @extra_argv = @{$self->command_args}; my @chain = @{$self->command_chain} # in this case only ( $myzapp ) # where $myzapp == $self } 1; package MyZapp::Cmd::Command; # for "myapp command" use Moo; use MooX::Cmd execute_from_new => 0; # gets executed on "myapp command" but not on "myapp command command" # there MyApp::Cmd::Command still gets instantiated and for the chain sub execute { my ( $self ) = @_; my @extra_argv = @{$self->command_args}; my @chain = @{$self->command_chain} # in this case ( $myzapp, $myzapp_cmd_command ) # where $myzapp_cmd_command == $self } 1; package main; use MyApp; MyZapp->new_with_cmd->execute(); MyApp->new_with_cmd; 1; =head1 DESCRIPTION Eases the writing of command line utilities, accepting commands and subcommands and so on. These commands can form a tree, which is mirrored in the package structure. On invocation each command along the path through the tree (starting from the toplevel command through to the most specific one) is instanciated. Each command needs to have an C function, accepting three parameters: =over =item C A reference to the specific L object that is executing. =item C An ArrayRef of arguments passed to C. This only encompasses arguments of the most specific (read: right-most) command. =item C An ArrayRef of Cs along the tree path, as specified on the command line. =back B =head3 L Attributes Each command has some attributes set by L during initialization: =over =item C Same as C argument to C. =item C TODO =item C TODO =item C TODO =item C TODO =back =head2 Examples =head3 A Single Toplevel Command #!/usr/bin/env perl package MyApp; use Moo; use MooX::Cmd; sub execute { my ($self,$args,$chain) = @_; printf("%s.execute(\$self,[%s],[%s])\n", ref($self), # which command is executing? join(", ", @$args ), # what where the arguments? join(", ", map { ref } @$chain) # what's in the command chain? ); } package main; MyApp->new_with_cmd(); Some sample invocations: $ ./MyApp.pl MyApp.execute($self,[],[MyApp]) $./MyApp.pl --opt1 MyApp.execute($self,[--opt1],[MyApp]) $ ./MyApp.pl --opt1 arg MyApp.execute($self,[--opt1, arg],[MyApp]) =head3 Toplevel Command with Subcommand #!/usr/bin/env perl # let's define a base class containing our generic execute # function to save some typing... package CmdBase; use Moo; sub execute { my ($self,$args,$chain) = @_; printf("%s.execute(\$self,[%s],[%s])\n", ref($self), join(", ", @$args ), join(", ", map { ref } @$chain) ); } package MyApp; # toplevel command/app use Moo; use MooX::Cmd; extends 'CmdBase'; package MyApp::Cmd::frobnicate; # can be called via ./MyApp.pl frobnicate use Moo; use MooX::Cmd; extends 'CmdBase'; package main; MyApp->new_with_cmd(); And some sample invocations: $ ./MyApp.pl frobnicate MyApp::Cmd::frobnicate.execute($self,[],[MyApp, MyApp::Cmd::frobnicate]) As you can see the chain contains our toplevel command object and then the specififc one. $ ./MyApp.pl frobnicate arg1 MyApp::Cmd::frobnicate.execute($self,[arg1],[MyApp, MyApp::Cmd::frobnicate]) Arguments are passed via the C parameter. $ ./MyApp.pl some --stuff frobnicate arg1 MyApp::Cmd::frobnicate.execute($self,[arg1],[MyApp, MyApp::Cmd::frobnicate]) Arguments to commands higher in the tree get ignored if they don't match a command. =head3 Access Toplevel Attributes via Chain #!/usr/bin/env perl package CmdBase; use Moo; sub execute { my ($self,$args,$chain) = @_; printf("%s.execute(\$self,[%s],[%s])\n", ref($self), join(", ", @$args ), join(", ", map { ref } @$chain) ); } package MyApp; use Moo; use MooX::Cmd; extends 'CmdBase'; has somevar => ( is => 'ro', default => 'someval' ); package MyApp::Cmd::frobnicate; use Moo; use MooX::Cmd; extends 'CmdBase'; around execute => sub { my ($orig,$self,$args,$chain) = @_; $self->$orig($args,$chain); # we can access toplevel attributes via the chain... printf("MyApp->somevar = '%s'\n", $chain->[0]->somevar); }; package main; MyApp->new_with_cmd(); A sample invocation $ ./MyApp.pl some --stuff frobnicate arg1 MyApp::Cmd::frobnicate.execute($self,[arg1],[MyApp, MyApp::Cmd::frobnicate]) MyApp->somevar = someval =head2 L integration You can integrate L simply by using it and declaring some options, like so: #!/usr/bin/env perl package MyApp; use Moo; use MooX::Cmd; use MooX::Options; option debug => ( is => 'ro' ); sub execute { my ($self,$args,$chain) = @_; print "debugging enabled!\n" if $self->{debug}; } package main; MyApp->new_with_cmd(); A sample invocation $ ./MyApp-Options.pl --debug debugging enabled! B, so options are parsed for the specific context and used for the instantiation: $ ./MyApp.pl --argformyapp command --argformyappcmdcommand ... =head1 SUPPORT Repository http://github.com/Getty/p5-moox-cmd Pull request and additional contributors are welcome Issue Tracker http://github.com/Getty/p5-moox-cmd/issues http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooX-Cmd bug-moox-cmd at rt.cpan.org =head1 THANKS =over =item Lukas Mai (mauke), Toby Inkster (tobyink) Gave some helpful advice for solving difficult issues =item Celogeek San Integration into MooX::Options for better help messages and suit team play =item Torsten Raudssus (Getty) did the initial work and brought it to CPAN =back =head1 LICENSE AND COPYRIGHT Copyright 2012-2013 Torsten Raudssus, Copyright 2013-2015 Jens Rehsack. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut MooX-Cmd-0.015/lib/MooX/Cmd/Role/000755 000765 000024 00000000000 12532043707 016103 5ustar00snostaff000000 000000 MooX-Cmd-0.015/lib/MooX/Cmd/Role.pm000644 000765 000024 00000022512 12532042662 016442 0ustar00snostaff000000 000000 package MooX::Cmd::Role; use strict; use warnings; our $VERSION = "0.015"; use Moo::Role; use Carp; use Module::Runtime qw/ use_module /; use Regexp::Common; use Text::ParseWords 'shellwords'; use Module::Pluggable::Object; use List::MoreUtils qw/first_index first_result/; use Scalar::Util qw/blessed/; use Params::Util qw/_ARRAY/; =head1 NAME MooX::Cmd::Role - MooX cli app commands do this =head1 SYNOPSIS =head2 using role and want behavior as MooX::Cmd package MyFoo; with MooX::Cmd::Role; sub _build_command_execute_from_new { 1 } package main; my $cmd = MyFoo->new_with_cmd; =head2 using role and don't execute immediately package MyFoo; with MooX::Cmd::Role; use List::MoreUtils qw/ first_idx /; sub _build_command_base { "MyFoo::Command" } sub _build_command_execute_from_new { 0 } sub execute { my $self = shift; my $chain_idx = first_idx { $self == $_ } @{$self->command_chain}; my $next_cmd = $self->command_chain->{$chain_idx+1}; $next_cmd->owner($self); $next_cmd->execute; } package main; my $cmd = MyFoo->new_with_cmd; $cmd->command_chain->[-1]->run(); =head2 explicit expression of some implicit stuff package MyFoo; with MooX::Cmd::Role; sub _build_command_base { "MyFoo::Command" } sub _build_command_execute_method_name { "run" } sub _build_command_execute_from_new { 0 } package main; my $cmd = MyFoo->new_with_cmd; $cmd->command_chain->[-1]->run(); =head1 DESCRIPTION MooX::Cmd::Role is made for modern, flexible Moo style to tailor cli commands. =head1 ATTRIBUTES =head2 command_args ARRAY-REF of args on command line =cut has 'command_args' => ( is => "ro" ); =head2 command_chain ARRAY-REF of commands lead to this instance =cut has 'command_chain' => ( is => "ro" ); =head2 command_chain_end COMMAND accesses the finally detected command in chain =cut has 'command_chain_end' => ( is => "lazy" ); sub _build_command_chain_end { $_[0]->command_chain->[-1] } =head2 command_name ARRAY-REF the name of the command lead to this command =cut has 'command_name' => ( is => "ro" ); =head2 command_commands HASH-REF names of other commands =cut has 'command_commands' => ( is => "lazy" ); sub _build_command_commands { my ( $class, $params ) = @_; defined $params->{command_base} or $params->{command_base} = $class->_build_command_base($params); my $base = $params->{command_base}; # i have no clue why 'only' and 'except' seems to not fulfill what i need or are bugged in M::P - Getty my @cmd_plugins = grep { my $plug_class = $_; $plug_class =~ s/${base}:://; $plug_class !~ /:/; } Module::Pluggable::Object->new( search_path => $base, require => 0, )->plugins; my %cmds; for my $cmd_plugin (@cmd_plugins) { $cmds{ _mkcommand( $cmd_plugin, $base ) } = $cmd_plugin; } \%cmds; } =head2 command_base STRING base of command plugins =cut has command_base => ( is => "lazy" ); sub _build_command_base { $_[0] . '::Cmd'; } =head2 command_execute_method_name STRING name of the method to invoke to execute a command, default "execute" =cut has command_execute_method_name => ( is => "lazy" ); sub _build_command_execute_method_name { "execute" } =head2 command_execute_return_method_name STRING I have no clue what that is good for ... =cut has command_execute_return_method_name => ( is => "lazy" ); sub _build_command_execute_return_method_name { "execute_return" } =head2 command_creation_method_name STRING name of constructor =cut has command_creation_method_name => ( is => "lazy" ); sub _build_command_creation_method_name { "new_with_cmd" } =head2 command_creation_chain_methods ARRAY-REF names of methods to chain for creating object (from L) =cut has command_creation_chain_methods => ( is => "lazy" ); sub _build_command_creation_chain_methods { [ 'new_with_options', 'new' ] } =head2 command_execute_from_new BOOL true when constructor shall invoke L, false otherwise =cut has command_execute_from_new => ( is => "lazy" ); sub _build_command_execute_from_new { 0 } =head1 METHODS =head2 new_with_cmd initializes by searching command line args for commands and invoke them =cut sub new_with_cmd { goto &_initialize_from_cmd; } sub _mkcommand { my ( $package, $base ) = @_; $package =~ s/^${base}:://g; lc($package); } my @private_init_params = qw(command_base command_execute_method_name command_execute_return_method_name command_creation_chain_methods command_execute_method_name); my $required_method = sub { my ( $tgt, $method ) = @_; $tgt->can($method) or croak( "You need an '$method' in " . ( blessed $tgt || $tgt ) ); }; my $call_required_method = sub { my ( $tgt, $method, @args ) = @_; my $m = $required_method->( $tgt, $method ); return $m->( $tgt, @args ); }; my $call_optional_method = sub { my ( $tgt, $method, @args ) = @_; my $m = $tgt->can($method) or return; return $m->( $tgt, @args ); }; my $call_indirect_method = sub { my ( $tgt, $name_getter, @args ) = @_; my $g = $call_required_method->( $tgt, $name_getter ); my $m = $required_method->( $tgt, $g ); return $m->( $tgt, @args ); }; sub _initialize_from_cmd { my ( $class, %params ) = @_; my @args = shellwords( join ' ', map { quotemeta } @ARGV ); my ( @used_args, $cmd, $cmd_name, $cmd_name_index ); my %cmd_create_params = %params; delete @cmd_create_params{ qw(command_commands), @private_init_params }; defined $params{command_commands} or $params{command_commands} = $class->_build_command_commands( \%params ); if ( ( $cmd_name_index = first_index { $cmd = $params{command_commands}->{$_} } @args ) >= 0 ) { @used_args = splice @args, 0, $cmd_name_index; $cmd_name = shift @args; # be careful about relics use_module($cmd); defined $cmd_create_params{command_execute_method_name} or $cmd_create_params{command_execute_method_name} = $call_optional_method->( $cmd, "_build_command_execute_method_name", \%cmd_create_params ); defined $cmd_create_params{command_execute_method_name} or $cmd_create_params{command_execute_method_name} = "execute"; $required_method->( $cmd, $cmd_create_params{command_execute_method_name} ); } else { @used_args = @args; @args = (); } defined $params{command_creation_chain_methods} or $params{command_creation_chain_methods} = $class->_build_command_creation_chain_methods( \%params ); my @creation_chain = _ARRAY( $params{command_creation_chain_methods} ) ? @{ $params{command_creation_chain_methods} } : ( $params{command_creation_chain_methods} ); ( my $creation_method = first_result { defined $_ and $class->can($_) } @creation_chain ) or croak "Can't find a creation method on $class"; @ARGV = @used_args; $params{command_args} = [@args]; $params{command_name} = $cmd_name; defined $params{command_chain} or $params{command_chain} = []; my $self = $creation_method->( $class, %params ); push @{ $self->command_chain }, $self; if ($cmd) { @ARGV = @args; my ( $creation_method, $creation_method_name, $cmd_plugin ); $cmd->can("_build_command_creation_method_name") and $creation_method_name = $cmd->_build_command_creation_method_name( \%params ); $creation_method_name and $creation_method = $cmd->can($creation_method_name); if ($creation_method) { @cmd_create_params{qw(command_chain)} = @$self{qw(command_chain)}; $cmd_plugin = $creation_method->( $cmd, %cmd_create_params ); $self->{ $self->command_execute_return_method_name } = [ @{ $call_indirect_method->( $cmd_plugin, "command_execute_return_method_name" ) } ]; } else { ( $creation_method = first_result { defined $_ and $cmd->can($_) } @creation_chain ) or croak "Can't find a creation method on " . $cmd; $cmd_plugin = $creation_method->($cmd); push @{ $self->command_chain }, $cmd_plugin; my $cemn = $cmd_plugin->can("command_execute_method_name"); my $exec_fun = $cemn ? $cemn->() : $self->command_execute_method_name(); $self->command_execute_from_new and $self->{ $self->command_execute_return_method_name } = [ $call_required_method->( $cmd_plugin, $exec_fun, \@ARGV, $self->command_chain ) ]; } } else { $self->command_execute_from_new and $self->{ $self->command_execute_return_method_name } = [ $call_indirect_method->( $self, "command_execute_method_name", \@ARGV, $self->command_chain ) ]; } return $self; } =head2 execute_return returns the content of $self->{execute_return} =cut # XXX should be an r/w attribute - can be renamed on loading ... sub execute_return { $_[0]->{execute_return} } =head1 LICENSE AND COPYRIGHT Copyright 2012-2013 Torsten Raudssus, Copyright 2013-2015 Jens Rehsack. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut 1; MooX-Cmd-0.015/lib/MooX/Cmd/Tester.pm000644 000765 000024 00000015537 12532042662 017020 0ustar00snostaff000000 000000 package MooX::Cmd::Tester; use strict; use warnings; our $VERSION = "0.015"; require Exporter; use Test::More import => ['!pass']; use Package::Stash; use Capture::Tiny qw(:all); use parent qw(Test::Builder::Module Exporter); our @EXPORT = qw(test_cmd test_cmd_ok); our @EXPORT_OK = qw(test_cmd test_cmd_ok); our $TEST_IN_PROGRESS; my $CLASS = __PACKAGE__; BEGIN { *CORE::GLOBAL::exit = sub { return CORE::exit(@_) unless $TEST_IN_PROGRESS; MooX::Cmd::Tester::Exited->throw( $_[0] ); }; } sub result_class { 'MooX::Cmd::Tester::Result' } sub test_cmd { my ( $app, $argv ) = @_; my $result = _run_with_capture( $app, $argv ); my $exit_code = defined $result->{error} ? ( ( 0 + $! ) || -1 ) : 0; $result->{error} and eval { $result->{error}->isa('MooX::Cmd::Tester::Exited') } and $exit_code = ${ $result->{error} }; result_class->new( { exit_code => $exit_code, %$result, } ); } sub test_cmd_ok { my $rv = test_cmd(@_); my $test_ident = $rv->app . " => [ " . join( " ", @{ $_[1] } ) . " ]"; ok( !$rv->error, "Everythink ok running cmd $test_ident" ) or diag( $rv->error ); # no error and cmd means, we're reasonable successful so far $rv and !$rv->error and $rv->cmd and $rv->cmd->command_name and ok( $rv->cmd->command_commands->{ $rv->cmd->command_name }, "found command at $test_ident" ); $rv; } sub _capture_merged(&) { my $code = shift; my ( $stdout, $stderr, $merged, $ok ); if ( $^O eq 'MSWin32' ) { ( $stdout, $stderr, $ok ) = tee { $code->(); }; $merged = $stdout . $stderr; } else { ($merged) = tee_merged { ( $stdout, $stderr, $ok ) = tee { $code->() }; }; } ( $stdout, $stderr, $merged, $ok ); } sub _run_with_capture { my ( $app, $argv ) = @_; my ( $execute_rv, $cmd, $cmd_name ); my ( $stdout, $stderr, $merged, $ok ) = _capture_merged { eval { local $TEST_IN_PROGRESS = 1; local @ARGV = @$argv; my $tb = $CLASS->builder(); $cmd = ref $app ? $app : $app->new_with_cmd; ref $app and $app = ref $app; my $test_ident = "$app => [ " . join( " ", @$argv ) . " ]"; ok( $cmd->isa($app), "got a '$app' from new_with_cmd" ); @$argv and defined( $cmd_name = $cmd->command_name ) and ok( ( grep { $_ =~ m/$cmd_name/ } @$argv ), "proper cmd name from $test_ident" ); ok( scalar @{ $cmd->command_chain } <= 1 + scalar @$argv, "\$#argv vs. command chain length testing $test_ident" ); @$argv and ok( $cmd->command_chain_end == $cmd->command_chain->[-1], "command_chain_end ok" ); unless ( $execute_rv = $cmd->execute_return ) { my ( $command_execute_from_new, $command_execute_method_name ); my $cce = $cmd->can("command_chain_end"); $cce and $cce = $cce->($cmd); $cce and $command_execute_from_new = $cce->can("command_execute_from_new"); $command_execute_from_new and $command_execute_from_new = $command_execute_from_new->($cce); $command_execute_from_new or $command_execute_method_name = $cce->can('command_execute_method_name'); $command_execute_method_name and $execute_rv = [ $cce->can( $command_execute_method_name->($cce) )->($cce) ]; } 1; }; }; my $error = $ok ? undef : $@; return { app => $app, cmd => $cmd, stdout => $stdout, stderr => $stderr, output => $merged, error => $error, execute_rv => $execute_rv, }; } { package # no-index MooX::Cmd::Tester::Result; sub new { my ( $class, $arg ) = @_; bless $arg => $class; } } my $res = Package::Stash->new("MooX::Cmd::Tester::Result"); for my $attr (qw(app cmd stdout stderr output error execute_rv exit_code)) { $res->add_symbol( '&' . $attr, sub { $_[0]->{$attr} } ); } { package # no-index MooX::Cmd::Tester::Exited; sub throw { my ( $class, $code ) = @_; defined $code or $code = 0; my $self = ( bless \$code => $class ); die $self; } } =head1 NAME MooX::Cmd::Tester - MooX cli app commands tester =head1 SYNOPSIS use MooX::Cmd::Tester; use Test::More; use MyFoo; # basic tests as instance check, initialization check etc. is done there my $rv = test_cmd( MyFoo => [ command(s) option(s) ] ); like( $rv->stdout, qr/operation successful/, "Command performed" ); like( $rv->stderr, qr/patient dead/, "Deal with expected command error" ); is_deeply( $rv->execute_rv, \@expected_return_values, "got what I deserve?" ); cmp_ok( $rv->exit_code, "==", 0, "Command successful" ); =head1 DESCRIPTION The test coverage of most CLI apps is somewhere between poor and wretched. With the same approach as L comes MooX::Cmd::Tester to ease writing tests for CLI apps. =head1 FUNCTIONS =head2 test_cmd my $rv = test_cmd( MyApp => \@argv ); test_cmd invokes the app with given argv as if would be invoked from command line and captures the output, the return values and exit code. Some minor tests are done to prove whether class matches, execute succeeds, command_name and command_chain are not totally scrambled. It returns an object with following attributes/accessors: =head3 app Name of package of App =head3 cmd Name of executed (1st level) command =head3 stdout Content of stdout =head3 stderr Content of stderr =head3 output Content of merged stdout and stderr =head3 error the exception thrown by running the application (if any) =head3 execute_rv return values from execute =head3 exit_code 0 on success, $! when error occurred and $! available, -1 otherwise =head2 test_cmd_ok my $rv = test_cmd_ok( MyApp => \@argv ); Runs C and expects it being successful - command_name must be in command_commands, etc. Returns the same object C returns. If an error occurred, no additional test is done (behavior as C). =head2 result_class Builder for result class to use. Returns C by default. =head1 ACKNOWLEDGEMENTS MooX::Cmd::Tester is I by L from Ricardo Signes. In fact, I reused the entire design and adopt it to the requirements of MooX::Cmd. =head1 LICENSE AND COPYRIGHT Copyright 2013-2015 Jens Rehsack. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut 1; MooX-Cmd-0.015/lib/MooX/Cmd/Role/ConfigFromFile.pm000644 000765 000024 00000001672 12532042661 021276 0ustar00snostaff000000 000000 package MooX::Cmd::Role::ConfigFromFile; use strict; use warnings; our $VERSION = "0.015"; use Moo::Role; =head1 NAME MooX::Cmd::Role::ConfigFromFile - MooX::ConfigFromFile support role for MooX::Cmd =cut requires "config_prefixes"; around _build_config_prefixes => sub { my $next = shift; my $class = shift; my $params = shift; my $cfg_pfxs = $class->$next( $params, @_ ); ref $params->{command_chain} eq "ARRAY" and push @{$cfg_pfxs}, grep { defined $_ } map { $_->command_name } grep { $_->can("command_name") } @{ $params->{command_chain} }; return $cfg_pfxs; }; =head1 LICENSE AND COPYRIGHT Copyright 2015 Jens Rehsack. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut 1; MooX-Cmd-0.015/etc/04-moox-configfromfile.t-check-it.json000644 000765 000024 00000000037 12475345141 022641 0ustar00snostaff000000 000000 { "dedicated_setting": 1 } MooX-Cmd-0.015/etc/04-moox-configfromfile.t-check.json000644 000765 000024 00000000047 12475352124 022227 0ustar00snostaff000000 000000 { "unintialized_attribute": 4711 } MooX-Cmd-0.015/etc/04-moox-configfromfile.t.json000644 000765 000024 00000000070 12475350044 021147 0ustar00snostaff000000 000000 { "complicated_setting": { "say": "Hello!" } }