From 6d3c444a92410297193b0475650c4e9c1ebcfcdf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Fri, 11 Aug 2017 16:43:01 +0100 Subject: [PATCH 01/13] Make cmd_map map to possibly arbitrary packages This patch modifies the behaviour of cmd_map to always return the full name of the package implementing a given command, or return undef trying. Aliases that map to a string starting with a '+' sign are returned as-is, mimicking the behaviour in other distributions. This makes it possible to accept common commands (like 'help' or 'version') and pass them to existing packages that can be extended by other users. --- lib/App/CLI.pm | 42 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm index 7dd9f81..fa07de1 100644 --- a/lib/App/CLI.pm +++ b/lib/App/CLI.pm @@ -205,18 +205,41 @@ sub dispatch { =head3 cmd_map($cmd) -Find package name of subcommand in constant C<%alias>. +Find the name of the package implementing the requested command. -If it's found, return C of the package name, otherwise, return -C of C<$cmd> itself. +The command is first searched for in C. If the alias exists and points +to a package name starting with the C<+> sign, then that package name (minus +the C<+> sign) is returned. This makes it possible to map commands to arbitrary +packages. + +Otherwise, the package is searched for in the result of calling C, +and a package name is constructed by upper-casing the first character of the +command name, and appending it to the package name of the app itself. + +If both of these fail, and the command does not map to any package name, +C is returned instead. =cut sub cmd_map { - my ($pkg, $cmd) = @_; - my %alias = $pkg->alias; - $cmd = $alias{$cmd} if exists $alias{$cmd}; - return ucfirst($cmd); + my ($self, $cmd) = @_; + + my %alias = $self->alias; + + if (exists $alias{$cmd}) { + $cmd = $alias{$cmd}; + + # Alias points to package name, return immediately + return $cmd if $cmd =~ s/^\+//; + } + + ($cmd) = grep { $_ eq $cmd } $self->commands; + + # No such command + return unless $cmd; + + my $base = ref $self->app; + return join '::', $base, ucfirst $cmd; } sub error_cmd { @@ -246,7 +269,10 @@ sub get_cmd { die $self->error_cmd($cmd) unless $cmd && $cmd eq lc($cmd); my $base = ref $self; - my $pkg = join('::', $base, $self->cmd_map($cmd)); + my $pkg = $self->cmd_map($cmd); + + die $self->error_cmd($cmd) unless $pkg; + load_class $pkg; die $self->error_cmd($cmd) unless $pkg->can('run'); From dae33ba4a45c6d8c40c9e7161337f2362af720db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 12:19:42 +0100 Subject: [PATCH 02/13] Add a prog_name function to the Helper class --- lib/App/CLI/Helper.pm | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/lib/App/CLI/Helper.pm b/lib/App/CLI/Helper.pm index aa8e747..055b960 100644 --- a/lib/App/CLI/Helper.pm +++ b/lib/App/CLI/Helper.pm @@ -3,10 +3,12 @@ package App::CLI::Helper; use strict; use warnings; +use File::Basename qw( basename ); + sub import { no strict 'refs'; my $caller = caller; - for (qw(commands files)) { + for (qw(commands files prog_name)) { *{$caller."::$_"} = *$_; } } @@ -37,6 +39,28 @@ sub commands { return sort @cmds; } +=head3 prog_name() + +The name of the program running your application. This will default to +C, but can be overiden from within your application. + +=cut + +{ + my $default; + sub prog_name { + my $self = shift; + + $default = basename $0 unless $default; + return $default unless ref $self; + + return $self->{prog_name} if defined $self->{prog_name}; + + $self->{prog_name} = basename $0; + return $self->{prog_name}; + } +} + =head3 files() return module files of subcommans of first level From 2249271edb688c2a5af885eb2c3e3ce17e5ec4ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 12:01:32 +0100 Subject: [PATCH 03/13] Add default version command --- lib/App/CLI/Command/Version.pm | 41 ++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 lib/App/CLI/Command/Version.pm diff --git a/lib/App/CLI/Command/Version.pm b/lib/App/CLI/Command/Version.pm new file mode 100644 index 0000000..09f0395 --- /dev/null +++ b/lib/App/CLI/Command/Version.pm @@ -0,0 +1,41 @@ +package App::CLI::Command::Version; + +use strict; +use warnings; + +use base qw/App::CLI::Command/; + +=head1 NAME + +App::CLI::Command::Version - Print a preformatted version string + +=head1 SYNOPSIS + + package MyApp; + use base qw(App::CLI App::CLI::Command); + + use constant alias => ( + '--version' => '+App::CLI::Command::Version', + 'version' => '+App::CLI::Command::Version', + # Other aliases + ); + + # Your app now supports a default version command and option + +=head1 DESCRIPTION + +This is package provides a default C command modelled after +that of L. You can modify the default message by subclassing +this command and overriding its C method, or by modifying it with +eg. L. + +=cut + +sub run { + my ($self) = shift; + no strict 'refs'; + print sprintf "%s (%s) version %s (%s)\n", + $self->app->prog_name, ref $self->app, $self->app->VERSION, $0; +} + +1; From e93db7e3fd44e259ed65bac5f729d970e902fa66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 12:11:14 +0100 Subject: [PATCH 04/13] Add Usage class, outsourcing POD munging to Pod::Usage Until now, the usage commands parsed the POD of a specified file manually opening a filehandle and using Pod::Simple::Text. This was done everywhere that required parsing the POD, which included the default Help command, as well as the usage and brief_usage functions. This commit implements a App::CLI::Usage class that is simply a wrapper around Pod::Usage (or whatever other POD parser is passed as argument). --- lib/App/CLI/Usage.pm | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 lib/App/CLI/Usage.pm diff --git a/lib/App/CLI/Usage.pm b/lib/App/CLI/Usage.pm new file mode 100644 index 0000000..311d068 --- /dev/null +++ b/lib/App/CLI/Usage.pm @@ -0,0 +1,39 @@ +package App::CLI::Usage; + +use strict; +use warnings; + +use Pod::Usage; + +sub new { + my $class = shift; + my $args = @_ ? @_ > 1 ? { @_ } : shift : {}; + $args->{select} = '(?:NAME|SYNOPSIS|DESCRIPTION)\s*' unless $args->{select}; + $args->{parser} = Pod::Usage->new unless $args->{parser}; + + my $self = bless $args, $class; + $self->select($self->{select}); + + return $self; +} + +sub select { $_[0]->parser->select(@_) } + +sub parser { + my $self = shift; + $self->{parser} = shift if @_; + return $self->{parser}; +} + +sub parse_file { + my ($self, $filename) = @_; + + my $usage = q{}; + use autodie; + open my $fh, '>', \$usage; + $self->parser->parse_from_file($filename, $fh); + + return $usage; +} + +1; From 2ebd8bf4a225a1fb6ff7b745487910e1b8c5edd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 15:30:20 +0100 Subject: [PATCH 05/13] Add usage_desc as an attribute of commands The usage_desc attribute, inspired by that of App::Cmd, will be used to give the user some high-level customisation when generating brief usage messages. This will be done with String::Format, emulating the behaviour of App::Cmd. --- lib/App/CLI/Command.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm index ab1d401..b5aa48e 100644 --- a/lib/App/CLI/Command.pm +++ b/lib/App/CLI/Command.pm @@ -40,6 +40,7 @@ App::CLI::Command - Base class for App::CLI commands use constant subcommands => (); use constant options => (); +use constant usage_desc => '%c %C %o'; sub new { my $class = shift; From 755581f0aa7d14afea047b8754c383df49674f58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 12:15:15 +0100 Subject: [PATCH 06/13] Command usage uses Usage class --- lib/App/CLI/Command.pm | 77 +++++++++++++++++++++++++++--------------- 1 file changed, 49 insertions(+), 28 deletions(-) diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm index b5aa48e..9eb0c1d 100644 --- a/lib/App/CLI/Command.pm +++ b/lib/App/CLI/Command.pm @@ -3,9 +3,13 @@ use strict; use warnings; use Locale::Maketext::Simple; use Carp (); + use App::CLI::Helper; +use App::CLI::Usage; + use Class::Load qw( load_class ); use Scalar::Util qw( weaken ); +use String::Format; =head1 NAME @@ -143,49 +147,66 @@ sub app { =head3 brief_usage ($file) -Display a one-line brief usage of the command object. Optionally, a file -could be given to extract the usage from the POD. +Display a one-line brief usage of the command object. =cut sub brief_usage { - my ($self, $file) = @_; - open my ($podfh), '<', ($file || $self->filename) or return; - local $/=undef; - my $buf = <$podfh>; - my $base = $self->app; - if($buf =~ /^=head1\s+NAME\s*\Q$base\E::(\w+ - .+)$/m) { - print " ",loc(lc($1)),"\n"; - } else { - my $cmd = $file ||$self->filename; - $cmd =~ s/^(?:.*)\/(.*?).pm$/$1/; - print " ", lc($cmd), " - ",loc("undocumented")."\n"; + my ($self) = @_; + + my $option_string = q{}; + my $program_name = $self->prog_name; + my @components = split /::/, ref $self; + my $command_name = lc pop @components; + $command_name = '' if ref $self->app eq ref $self; + + my %options; + %options = $self->global_options if $self->can('global_options'); + %options = (%options, $self->options); + + if (%options) { + my (@short, @long); + + foreach my $opt (keys %options) { + foreach (split qr{\|}, $opt) { + (length == 1) + ? push @short, $_ + : push @long, $_; + } + } + + $option_string = '[' . join(q{}, sort @short) . ']' if @short; + $option_string .= ' [long options]' if @long; } - close $podfh; + + return stringf( $self->usage_desc . "\n\n" => + 'c' => $program_name, + 'C' => $command_name, + 'o' => $option_string, + ); } =head3 usage ($want_detail) -Display usage. If C<$want_detail> is true, the C +Display usage. If C<$want_detail> is true, the C section is displayed as well. =cut sub usage { my ($self, $want_detail) = @_; - my $fname = $self->filename; - my ($cmd) = $fname =~ m{\W(\w+)\.pm$}; - require Pod::Simple::Text; - my $parser = Pod::Simple::Text->new; - my $buf; - $parser->output_string(\$buf); - $parser->parse_file($fname); - - my $base = $self->app; - $buf =~ s/\Q$base\E::(\w+)/\l$1/g; - $buf =~ s/^AUTHORS.*//sm; - $buf =~ s/^DESCRIPTION.*//sm unless $want_detail; - print $self->loc_text($buf); + + my $select = '(?:NAME|SYNOPSIS' + . ($want_detail ? '|DESCRIPTION' : '') + . ')\s*'; + + my $usage = $self->brief_usage; + + my $parser = App::CLI::Usage->new( select => $select ); + $usage .= $parser->parse_file( $self->filename ); + + print $usage; + return $usage; } =head3 loc_text $text From 1939d6208fb5e140eedd13a4172e5b24402b1136 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 12:07:23 +0100 Subject: [PATCH 07/13] Default help command uses usage methods --- lib/App/CLI/Command/Help.pm | 66 ++++--------------------------------- 1 file changed, 6 insertions(+), 60 deletions(-) diff --git a/lib/App/CLI/Command/Help.pm b/lib/App/CLI/Command/Help.pm index 1fd7a5f..bdf8ecf 100644 --- a/lib/App/CLI/Command/Help.pm +++ b/lib/App/CLI/Command/Help.pm @@ -1,10 +1,14 @@ package App::CLI::Command::Help; + use strict; use warnings; + use base qw/App::CLI::Command/; + use File::Find qw(find); use Locale::Maketext::Simple; use Pod::Simple::Text; +use Class::Load qw( load_class ); =head1 NAME @@ -50,66 +54,8 @@ sub run { my $self = shift; my @topics = @_; - push @topics, 'commands' unless (@topics); - - foreach my $topic (@topics) { - if ($topic eq 'commands') { - $self->brief_usage ($_) for $self->app->files; - } - elsif (my $cmd = eval { $self->app->get_cmd ($topic) }) { - $cmd->usage(1); - } - elsif (my $file = $self->_find_topic($topic)) { - open my $fh, '<:utf8', $file or die $!; - require Pod::Simple::Text; - my $parser = Pod::Simple::Text->new; - my $buf; - $parser->output_string(\$buf); - $parser->parse_file($fh); - - $buf =~ s/^NAME\s+(.*?)::Help::\S+ - (.+)\s+DESCRIPTION/ $2:/; - print $self->loc_text($buf); - } - else { - die loc("Cannot find help topic '%1'.\n", $topic); - } - } - return; -} - -sub help_base { - my $self = shift; - return $self->app."::Help"; -} - -my ($inc, @prefix); -sub _find_topic { - my ($self, $topic) = @_; - - if (!$inc) { - my $pkg = __PACKAGE__; - $pkg =~ s{::}{/}; - $inc = substr( __FILE__, 0, -length("$pkg.pm") ); - - my $base = $self->help_base; - @prefix = (loc($base)); - $prefix[0] =~ s{::}{/}g; - $base =~ s{::}{/}g; - push @prefix, $base if $prefix[0] ne $base; - } - - foreach my $dir ($inc, @INC) { - foreach my $prefix (@prefix) { - foreach my $basename (ucfirst(lc($topic)), uc($topic)) { - foreach my $ext ('pod', 'pm') { - my $file = "$dir/$prefix/$basename.$ext"; - return $file if -f $file; - } - } - } - } - - return; + return $self->app->usage unless @topics; + return $self->app->get_cmd($_)->usage foreach @topics; } 1; From 781c880e86f6ed89ca56efb0d43a8127c136a338 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 15:29:46 +0100 Subject: [PATCH 08/13] Guard against undef data in get_cmd --- lib/App/CLI.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm index fa07de1..59e3e82 100644 --- a/lib/App/CLI.pm +++ b/lib/App/CLI.pm @@ -277,7 +277,7 @@ sub get_cmd { die $self->error_cmd($cmd) unless $pkg->can('run'); - my @arg = %$data; + my @arg = defined $data ? %$data : (); $cmd = $pkg->new(@arg); $cmd->app($self); return $cmd; From d1e95c87c691d4ae1e92a583e2468404ac3576c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 15:48:28 +0100 Subject: [PATCH 09/13] Add an abstract() method to parse abstract from POD --- lib/App/CLI/Command.pm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm index 9eb0c1d..9d0e075 100644 --- a/lib/App/CLI/Command.pm +++ b/lib/App/CLI/Command.pm @@ -242,6 +242,22 @@ sub loc_text { return $out; } +=head3 abstract() + +Return the parsed abstract of the package implementing this command. + +=cut + +sub abstract { + my ($self) = @_; + + my $parser = App::CLI::Usage->new( select => '(?:NAME)\s*' ); + my $abstract = $parser->parse_file( $self->filename ); + $abstract =~ s/Name:[\n\s]*[\w:]+(\s+-\s+)?//m; + $abstract =~ s/[\n\s]*$//m; + return $abstract; +} + =head3 filename Return the filename for the command module. From eeefd6763a75dd64c24de79f456ae467ee5a2ada Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 15:49:00 +0100 Subject: [PATCH 10/13] Make commands() optionally include aliases Although 08d620b9bab541190870da61c18813a047181ba2 makes commands() return the list of commands, including any aliases, it can be useful to have a distinction between proper commands, and _all_ commands. This patch enables both behaviours by keeping the plain function call as returning only the command names (keeping the old interface), and requiring a true argument to be passed in order to include any aliases. --- lib/App/CLI/Helper.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/App/CLI/Helper.pm b/lib/App/CLI/Helper.pm index 055b960..92965f6 100644 --- a/lib/App/CLI/Helper.pm +++ b/lib/App/CLI/Helper.pm @@ -22,7 +22,7 @@ sub import { sub commands { - my $class = shift; + my ($class, $include_alias) = @_; my $dir = ref($class) || $class; $dir =~ s{::}{/}g; @@ -31,7 +31,7 @@ sub commands { my @cmds = map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files; - if (ref $class and $class->can('alias')) { + if ($include_alias and ref $class and $class->can('alias')) { my %aliases = $class->alias; push @cmds, $_ foreach keys %aliases; } From 97defba17dc383aafc4540a754de790d44790eb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 15:49:36 +0100 Subject: [PATCH 11/13] Add a default commands command --- lib/App/CLI/Command/Commands.pm | 45 +++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 lib/App/CLI/Command/Commands.pm diff --git a/lib/App/CLI/Command/Commands.pm b/lib/App/CLI/Command/Commands.pm new file mode 100644 index 0000000..4a987f1 --- /dev/null +++ b/lib/App/CLI/Command/Commands.pm @@ -0,0 +1,45 @@ +package App::CLI::Command::Commands; + +use strict; +use warnings; + +use base qw/App::CLI::Command/; + +=head1 NAME + +App::CLI::Command::Commands - Print a list of commands for your app + +=head1 SYNOPSIS + + package MyApp; + use base qw(App::CLI App::CLI::Command); + + # Make your app get a list of commands + use constant alias => ( + commands => 'App::CLI::Command::Commands', + ); + + 1; + +=head1 DESCRIPTION + +Print a list of commands registered for your application; + +=cut + +sub run { + my ($self) = shift; + + my ($longest) = sort {length($b) cmp length($a)} $self->app->commands; + $longest = length $longest; + + foreach ($self->app->commands) { + my $cmd = $self->app->get_cmd($_); + my @components = split /::/, ref $cmd; + my $name = lc pop @components; + printf " %${longest}s: %s\n", $name, lc($cmd->abstract) || '[ undocumented ]'; + } + print "\n"; +} + +1; From 4fb92d1838459696b22dfc3f9b511f248d25cfe0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 15:54:36 +0100 Subject: [PATCH 12/13] Add Test::MyCmd test app, modeled after App::Cmd This patch adds a port of the Test::MyCmd test app present in the App::Cmd distribution. This serves to illustrate a way in which equivalent behaviour can be implemented in both distributions, which can help users make a choice between the two, and also makes it easier to use the test suite from App::Cmd as a baseline for testing App::CLI. --- t/lib/Test/MyCmd.pm | 41 +++++++++++++++++++++++++++++++++++ t/lib/Test/MyCmd/Exit.pm | 13 +++++++++++ t/lib/Test/MyCmd/Frobulate.pm | 19 ++++++++++++++++ t/lib/Test/MyCmd/Hello.pm | 24 ++++++++++++++++++++ t/lib/Test/MyCmd/Justusage.pm | 25 +++++++++++++++++++++ t/lib/Test/MyCmd/Stock.pm | 16 ++++++++++++++ 6 files changed, 138 insertions(+) create mode 100644 t/lib/Test/MyCmd.pm create mode 100644 t/lib/Test/MyCmd/Exit.pm create mode 100644 t/lib/Test/MyCmd/Frobulate.pm create mode 100644 t/lib/Test/MyCmd/Hello.pm create mode 100644 t/lib/Test/MyCmd/Justusage.pm create mode 100644 t/lib/Test/MyCmd/Stock.pm diff --git a/t/lib/Test/MyCmd.pm b/t/lib/Test/MyCmd.pm new file mode 100644 index 0000000..cd634c7 --- /dev/null +++ b/t/lib/Test/MyCmd.pm @@ -0,0 +1,41 @@ +package Test::MyCmd; + +use strict; +use warnings; + +use constant alias => ( + '--version' => '+App::CLI::Command::Version', + version => '+App::CLI::Command::Version', + '--help' => '+App::CLI::Command::Help', + help => '+App::CLI::Command::Help', + commands => '+App::CLI::Command::Commands', + frob => 'frobulate', +); + +use constant global_options => ( + 'v|verbose' => 'verbose', + 'F|force' => 'force', +); + +use parent qw(App::CLI App::CLI::Command); + +our $VERSION = '0.123'; + +1; + +__END__ + +=head1 NAME + +Test::MyCmd - A test command line application + +=head1 SYNOPSIS + + use Test::MyCmd; + Test::MyCmd->dispatch; + +=head1 DESCRIPTION + +Blib Bloob. + +=cut diff --git a/t/lib/Test/MyCmd/Exit.pm b/t/lib/Test/MyCmd/Exit.pm new file mode 100644 index 0000000..3a4f43a --- /dev/null +++ b/t/lib/Test/MyCmd/Exit.pm @@ -0,0 +1,13 @@ +package Test::MyCmd::Exit; + +use strict; +use warnings; + +use base qw(Test::MyCmd); + +sub run { + my ($self) = shift; + exit(defined $ARGV[0] ? $ARGV[0] : 0); +} + +1; diff --git a/t/lib/Test/MyCmd/Frobulate.pm b/t/lib/Test/MyCmd/Frobulate.pm new file mode 100644 index 0000000..d66e23e --- /dev/null +++ b/t/lib/Test/MyCmd/Frobulate.pm @@ -0,0 +1,19 @@ +package Test::MyCmd::Frobulate; + +use strict; +use warnings; + +use base qw(Test::MyCmd); + +use constant options => ( + 'foo-bar|F' => 'foo-bar', + 'widget=s' => 'widget', +); + +sub run { + my $self = shift; + $self->{widget} = '' unless defined $self->{widget}; + die "the widget name is $self->{widget} - @ARGV\n"; +} + +1; diff --git a/t/lib/Test/MyCmd/Hello.pm b/t/lib/Test/MyCmd/Hello.pm new file mode 100644 index 0000000..2cf0153 --- /dev/null +++ b/t/lib/Test/MyCmd/Hello.pm @@ -0,0 +1,24 @@ +package Test::MyCmd::Hello; + +use strict; +use warnings; + +use base qw(Test::MyCmd); + +use IPC::Cmd qw/can_run/; + +sub run { + my ($self, $opt, $arg) =@_; + + if ( $^O eq 'MSWin32' ) { + system('cmd', '/c', 'echo', "Hello World"); + } + else { + my $echo = can_run("echo"); + $self->usage_error("Program 'echo' not found") unless $echo; + system($echo, "Hello World"); + } + return; +} + +1; diff --git a/t/lib/Test/MyCmd/Justusage.pm b/t/lib/Test/MyCmd/Justusage.pm new file mode 100644 index 0000000..8797914 --- /dev/null +++ b/t/lib/Test/MyCmd/Justusage.pm @@ -0,0 +1,25 @@ +package Test::MyCmd::Justusage; + +use strict; +use warnings; + +use base qw(Test::MyCmd); + +use constant options => ( + 'd|detail' => 'detail', +); + +sub run { + my $self = shift; + die $self->usage($self->{detail}); +} + +1; + +__END__ + +=head1 NAME + +Test::MyCmd::Justusage - it just dies its own usage, no matter what + +=cut diff --git a/t/lib/Test/MyCmd/Stock.pm b/t/lib/Test/MyCmd/Stock.pm new file mode 100644 index 0000000..7fd1b2a --- /dev/null +++ b/t/lib/Test/MyCmd/Stock.pm @@ -0,0 +1,16 @@ +package Test::MyCmd::Stock; + +use strict; +use warnings; + +use base qw(Test::MyCmd); + +=head1 NAME + +Test::MyCmd::Stock - nothing here is overridden + +=cut + +# This package exists to test all the default command plugin behaviors. + +1; From 5733a033fdb469d4b003a028fb3e0979c1e8e8dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Mon, 14 Aug 2017 17:28:44 +0100 Subject: [PATCH 13/13] Update requirements in Makefile.PL --- Makefile.PL | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index f3cf87b..458577a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -17,12 +17,11 @@ WriteMakefile( ], LICENSE => "perl_5", PREREQ_PM => { - 'Locale::Maketext::Simple' => 0, 'Getopt::Long' => '2.35', - 'Pod::Simple::Text' => 0, 'Carp' => 0, 'File::Find' => 0, 'Class::Load' => 0, + 'String::Format' => 0, }, MIN_PERL_VERSION => 5.006, TEST_REQUIRES => {