App-Easer
view release on metacpan or search on metacpan
{
name => 'foo',
help => 'option foo!',
getopt => 'foo|f=s',
environment => 'FOO',
default => 'bar',
},
],
execute => sub ($instance) {
my $foo = $instance->config('foo');
say "Hello, $foo!";
return 0;
},
default_child => '-self', # run execute by default
children => [
{
aliases => ['bar'],
help => 'this is a sub-command',
description => 'Yes, this is a sub-command',
execute => sub { 'Peace!' },
},
docs/docs/10-tutorial-base.md view on Meta::CPAN
my $basedir = path($config->{basedir});
my (%cf, %pf);
my $limit = $config->{n};
for my $source (@candidates) {
next unless $included{$source};
for my $file (list_category($config, $source)) {
my $title = get_title($file);
my $sid = $config->{id} ? '-' . $file->basename : ++$cf{$source};
my $id = substr($source, 0, 1) . $sid;
say "$id [$source] $title";
last if $limit && ++$pf{$source} >= $limit;
} ## end for my $file (list_category...)
} ## end for my $source (@candidates)
return 0;
} ## end sub list
sub resolve ($config, $oid) {
fatal("no identifier provided") unless defined $oid;
my $id = $oid;
docs/docs/10-tutorial-base.md view on Meta::CPAN
$child = $children[$id - 1];
} ## end else [ if ($id =~ s{\A -}{}mxs)]
return $child;
} ## end sub resolve
sub show ($main, $config, $args) {
my $child = resolve($config, $args->[0]);
my $contents = $child->slurp_utf8;
$contents =~ s{\n\z}{}mxs;
say "----\n$contents\n----";
return 0;
} ## end sub show
sub cat ($main, $config, $args) {
my $child = resolve($config, $args->[0]);
print {*STDOUT} $child->slurp_utf8;
return 0;
} ## end sub show
sub fatal ($message) { die join(' ', @_) . "\n" }
docs/templates/getting-started.pl view on Meta::CPAN
exit run($application, [@ARGV]);
package MyApp;
# implementation of sub-command foo
sub foo ($general, $config, $args) {
# $general is a hash reference to the overall application
# $config is a hash reference with options
# $args is an array reference with "residual" cmd line arguments
for my $key (sort { $a cmp $b } keys $config->%*) {
say "$key: $config->{$key}";
}
say "($args->@*)";
return;
}
# implementation of sub-command bar
sub bar ($general, $config, $args) {
say defined($config->{galook}) ? $config->{galook} : '*undef*';
return;
}
eg/lib/MuDu/Command/List.pm view on Meta::CPAN
my $basedir = path($config->{basedir});
my (%cf, %pf);
my $limit = $config->{n};
for my $source (@candidates) {
next unless $included{$source};
for my $file (list_category($config, $source)) {
my $title = get_title($file);
my $sid = $config->{id} ? '-' . $file->basename : ++$cf{$source};
my $id = substr($source, 0, 1) . $sid;
say "$id [$source] $title";
last if $limit && ++$pf{$source} >= $limit;
} ## end for my $file (list_category...)
} ## end for my $source (@candidates)
return 0;
} ## end sub list
1;
eg/lib/MuDu/Command/Show.pm view on Meta::CPAN
description => 'Print one whole task',
supports => [qw< show print get >],
execute => __PACKAGE__,
};
}
sub execute ($main, $config, $args) {
my $child = resolve($config, $args->[0]);
my $contents = $child->slurp_utf8;
$contents =~ s{\n\z}{}mxs;
say "----\n$contents\n----";
return 0;
} ## end sub show
1;
my $basedir = $self->basedir;
my (%cf, %pf);
my $limit = $config->{n};
for my $source (@candidates) {
next unless $included{$source};
for my $file ($self->list_category($source)) {
my $title = $self->get_title($file);
my $sid = $config->{id} ? '-' . $file->basename : ++$cf{$source};
my $id = substr($source, 0, 1) . $sid;
say "$id [$source] $title";
last if $limit && ++$pf{$source} >= $limit;
} ## end for my $file ($self->list_category...)
} ## end for my $source (@candidates)
return 0;
} ## end sub list ($self)
sub cmd_ongoing ($self) {
$self->move_task;
}
sub cmd_remove ($self) {
$self->resolve->remove;
return 0;
}
sub cmd_show ($self) {
my $contents = $self->resolve->slurp_utf8;
$contents =~ s{\n\z}{}mxs;
say "----\n$contents\n----";
return 0;
} ## end sub show ($self)
sub cmd_waiting ($self) {
$self->move_task;
}
########################################################################
# Support methods
my $basedir = path($config->{basedir});
my (%cf, %pf);
my $limit = $config->{n};
for my $source (@candidates) {
next unless $included{$source};
for my $file (list_category($config, $source)) {
my $title = get_title($file);
my $sid = $config->{id} ? '-' . $file->basename : ++$cf{$source};
my $id = substr($source, 0, 1) . $sid;
say "$id [$source] $title";
last if $limit && ++$pf{$source} >= $limit;
} ## end for my $file (list_category...)
} ## end for my $source (@candidates)
return 0;
} ## end sub list
sub resolve ($config, $oid) {
fatal("no identifier provided") unless defined $oid;
my $id = $oid;
$child = $children[$id - 1];
} ## end else [ if ($id =~ s{\A -}{}mxs)]
return $child;
} ## end sub resolve
sub show ($main, $config, $args) {
my $child = resolve($config, $args->[0]);
my $contents = $child->slurp_utf8;
$contents =~ s{\n\z}{}mxs;
say "----\n$contents\n----";
return 0;
} ## end sub show
sub cat ($main, $config, $args) {
my $child = resolve($config, $args->[0]);
print {*STDOUT} $child->slurp_utf8;
return 0;
} ## end sub show
sub fatal ($message) { die join(' ', @_) . "\n" }
my $basedir = $self->basedir;
my (%cf, %pf);
my $limit = $config->{n};
for my $source (@candidates) {
next unless $included{$source};
for my $file ($self->list_category($source)) {
my $title = $self->get_title($file);
my $sid = $config->{id} ? '-' . $file->basename : ++$cf{$source};
my $id = substr($source, 0, 1) . $sid;
say "$id [$source] $title";
last if $limit && ++$pf{$source} >= $limit;
} ## end for my $file ($self->list_category...)
} ## end for my $source (@candidates)
return 0;
} ## end sub list ($self)
sub cmd_ongoing ($self) {
$self->move_task;
}
sub cmd_remove ($self) {
$self->resolve->remove;
return 0;
}
sub cmd_show ($self) {
my $contents = $self->resolve->slurp_utf8;
$contents =~ s{\n\z}{}mxs;
say "----\n$contents\n----";
return 0;
} ## end sub show ($self)
sub cmd_waiting ($self) {
$self->move_task;
}
########################################################################
# Support methods
lib/App/Easer.pod view on Meta::CPAN
{
name => 'foo',
help => 'option foo!',
getopt => 'foo|f=s',
environment => 'FOO',
default => 'bar',
},
],
execute => sub ($instance) {
my $foo = $instance->config('foo');
say "Hello, $foo!";
return 0;
},
default_child => '-self', # run execute by default
children => [
{
aliases => ['bar'],
help => 'this is a sub-command',
description => 'Yes, this is a sub-command',
execute => sub { 'Peace!' },
},
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
},
},
{
aliases => [qw< list >],
help => 'list names of available name/value pairs',
description => '',
options => [ ],
execute => sub ($self) {
my $dbpath = $self->config('db') // die "no db provided\n";
my $data = load_json($dbpath);
say {*STDOUT} $_ for sort { $a cmp $b } keys($data->%*);
exit 0;
},
},
],
};
exit(run($app, $0, @ARGV) // 0);
sub load_json ($path) {
open my $fh, '<:raw', $path;
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
},
},
{
aliases => [qw< list >],
help => 'list names of available name/value pairs',
description => '',
options => [ 'db' ],
execute => sub ($self) {
my $dbpath = $self->config('db') // die "no db provided\n";
my $data = load_json($dbpath);
say {*STDOUT} $_ for sort { $a cmp $b } keys($data->%*);
exit 0;
},
},
],
};
sub load_json ($path) {
open my $fh, '<:raw', $path;
local $/;
return JSON::PP::decode_json(<$fh>);
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
return;
},
children => [
{
aliases => [qw< seeker >],
help => 'some add-on to look at the seed!',
description => '',
options => [ '+parent' ],
execute => sub ($self) {
my $seed = $self->config('seed') // '**undef**';
say "seed is $seed";
return 0;
},
},
],
};
exit(run($app, $0, @ARGV) // 0);
The new key C<commit> in the parent command sets a callback that is
called immediately after the options gathering process for the specific
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
#next => [ qw< +CmdLine +Environment +Default +ParentSlices >],
final => [],
},
children => [
{
aliases => [qw< seeker >],
help => 'some add-on to look at the seed!',
description => '',
options => [ '+parent' ],
execute => sub ($self) {
say App::Easer::V2::dd(config => $self->config_hash);
return 0;
},
},
],
};
exit(run($app, $0, @ARGV) // 0);
sub get_from_url ($cmd, $opts, $args) {
my $url = $cmd->config('config_url');
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
next => [ qw< +CmdLine +Environment +Default +ParentSlices >],
},
children => [
{
aliases => [qw< seeker >],
help => 'some add-on to look at the seed!',
description => '',
options => [ '+parent' ],
execute => sub ($self) {
say App::Easer::V2::dd(config => $self->config_hash);
return 0;
},
},
],
};
exit(run($app, $0, @ARGV) // 0);
sub get_from_url ($cmd, $opts, $args) {
my $url = $cmd->config('config_url');
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
# the custom source is moved into final
final => [ \&get_from_url ],
},
children => [
{
aliases => [qw< seeker >],
help => 'some add-on to look at the seed!',
description => '',
options => [ '+parent' ],
execute => sub ($self) {
say App::Easer::V2::dd(config => $self->config_hash);
return 0;
},
},
],
};
exit(run($app, $0, @ARGV) // 0);
sub get_from_url ($cmd, $opts, $args) {
my $url = $cmd->config('config_url');
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
use App::Easer::V2 qw< run >;
my $app = {
aliases => [qw< MAIN >],
sources => 'v2.008',
config_hash_key => 'v2.008',
children => [
{
aliases => [qw< foo >],
execute => sub ($self) {
say 'foo here!';
return 0;
},
},
{
aliases => [qw< bar >],
execute => sub ($self) {
say 'bar here!';
return 0;
},
},
],
#####################################################################
# this sets what's done *by* the root command
execute => sub ($self) {
say 'MAIN (root) here!';
return 0;
},
#####################################################################
# this makes the command itself the default command to call when
# nothing more is provided on the command line. The default value
# is 'usage'.
default_child => '-self',
};
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
use App::Easer::V2 qw< run >;
my $app = {
aliases => [qw< MAIN >],
sources => 'v2.008',
config_hash_key => 'v2.008',
children => [
{
aliases => [qw< foo >],
execute => sub ($self) {
say 'foo here!';
return 0;
},
},
{
aliases => [qw< bar >],
execute => sub ($self) {
say 'bar here!';
return 0;
},
},
],
execute => sub ($self) {
my @args = $self->residual_args;
say "MAIN (root) here! Also got (@args)";
return 0;
},
default_child => '-self',
#####################################################################
# this sets the MAIN command as the default command to run if no
# child is found when additional residual-args are provided on the
# command line
fallback_to => '-self',
};
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
my $app = {
aliases => [qw< MAIN >],
sources => 'v2.008',
config_hash_key => 'v2.008',
children => [
{
aliases => [qw< foo bar >],
execute => sub ($self) {
my $name = $self->call_name;
say "$name here!";
return 0;
},
},
],
};
exit(run($app, $0, @ARGV) // 0);
Sample calls:
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
my $app = {
aliases => [qw< MAIN >],
sources => 'v2.008',
config_hash_key => 'v2.008',
children => [
{
aliases => [qw< foo bar >],
execute => sub ($self) {
my $name = $self->call_name;
say "$name here!";
return 0;
},
},
],
execute => sub ($self) {
my $path = $self->call_name;
my $name = $path =~ s{\A.*/}{}rmxs;
my @args = $self->residual_args;
say "$name (root) here! Also got (@args)";
return 0;
},
default_child => '-self',
fallback_to => '-self',
};
exit(run($app, $0, @ARGV) // 0);
Let's see it in action:
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
use App::Easer::V2 qw< run >;
my $app = {
aliases => [qw< MAIN >],
sources => 'v2.008',
config_hash_key => 'v2.008',
children => [
{
aliases => [qw< foo >],
execute => sub ($self) {
say 'foo here!';
return 0;
},
},
{
aliases => [qw< bar >],
execute => sub ($self) {
say 'bar here!';
return 0;
},
},
],
execute => sub ($self) {
my @args = $self->residual_args;
say "MAIN (root) here! Also got (@args)";
return 0;
},
default_child => '-self',
#####################################################################
# this sets the MAIN command as the default command to run if no
# child is found when additional residual-args are provided on the
# command line
fallback_to => '-self',
};
lib/App/Easer/Tutorial/V2_008.pod view on Meta::CPAN
use App::Easer::V2 -command => -spec => {
aliases => [qw< MAIN >],
sources => 'v2.008',
config_hash_key => 'v2.008',
default_child => '-self',
fallback_to => '-self',
};
sub execute ($self) {
my @args = $self->residual_args;
say "MAIN (root) here! Also got (@args)";
return 0;
};
package MyApp::CmdFoo;
use App::Easer::V2 -command => -spec => {
aliases => [qw< foo >],
};
sub execute ($self) {
say 'foo here!';
return 0;
};
package MyApp::CmdBar;
use App::Easer::V2 -command => -spec => {
aliases => [qw< bar >],
};
sub execute ($self) {
say 'bar here!';
return 0;
};
This setup allows a seamless transition of features from the hash-based
approach to the method-based one. As long as your application traits are
plain data (like C<aliases>, C<help>, etc.) it's possible to treat them
as such and keep them inside the hash provided as argument for C<use>;
everything different can be treated through a method.
As an example, you might want to keep help as POD in the file, and use
lib/App/Easer/V1.pm view on Meta::CPAN
{
name => 'foo',
description => 'option foo!',
getopt => 'foo|f=s',
environment => 'FOO',
default => 'bar',
},
],
execute => sub ($global, $conf, $args) {
my $foo = $conf->{foo};
say "Hello, $foo!";
return 0;
},
'default-child' => '', # run execute by default
},
},
},
[@ARGV]
) unless caller;
1;
lib/App/Easer/V1.pod view on Meta::CPAN
{
name => 'foo',
help => 'option foo!',
getopt => 'foo|f=s',
environment => 'FOO',
default => 'bar',
},
],
execute => sub ($global, $conf, $args) {
my $foo = $conf->{foo};
say "Hello, $foo!";
return 0;
},
'default-child' => '', # run execute by default
},
},
};
exit run($app, [@ARGV]);
Call examples:
lib/App/Easer/V2.pod view on Meta::CPAN
{
name => 'foo',
help => 'option foo!',
getopt => 'foo|f=s',
environment => 'FOO',
default => 'bar',
},
],
execute => sub ($instance) {
my $foo = $instance->config('foo');
say "Hello, $foo!";
return 0;
},
default_child => '-self', # run execute by default
children => [
{
aliases => ['bar'],
help => 'this is a sub-command',
description => 'Yes, this is a sub-command',
execute => sub { 'Peace!' },
},
lib/App/Easer/V2.pod view on Meta::CPAN
best, i.e. define applications through metadata only, through
object-oriented derivation, or through a mix of the two. The following
examples are aimed at producing the same application:
# metadata (mostly)
my $app_as_metadata = {
aliases => [qw< this that >],
help => 'this is the application, but also that',
options => [ { getopt => 'foo|f=s', default => 'bar' } ],
execute => sub ($app) {
say 'foo is ', $app->config('foo');
return 0;
},
};
# class only
package ThisThatApp;
use App::Easer::V2 '-command';
sub aliases ($self) { return [qw< this that >] }
sub help ($self) { return 'this is the application, but also that' }
sub options ($self) { [ { getopt => 'foo|f=s', default => 'bar' } ] }
sub execute ($self) {
say 'foo is ', $self->config('foo');
return 0;
}
# mixed style
package ThisThatMixedApp;
use App::Easer::V2 -command => -spec => {
aliases => [qw< this that >],
help => 'this is the application, but also that',
options => [ { getopt => 'foo|f=s', default => 'bar' } ],
};
sub execute ($self) {
say 'foo is ', $self->config('foo');
return 0;
}
The last style allows keeping data mostly as data, while leaving the
freedom to implement the logic as proper methods, which can be
beneficial for e.g. sharing common logic among several commands.
=head1 App::Easer::V2::Command METHODS
When a command is created, it is (usually) an instance of class
lib/App/Easer/V2.pod view on Meta::CPAN
my $instance = $self_or_package->instantiate($class, @args);
This method loads class C<$class> via C<load_module> and returns:
$class->new(@args);
This is a class method.
=item C<is_root>
say 'root command!' if $self->is_root;
Return I<true> if the command is the I<root>, i.e. if it has no parent.
Available after version C<2.007001>.
=item C<list_children>
my @children = $self->list_children;
Return the I<full> list of children for a command, including ones
gathered in the class tree and auto-generated ones (these are added only
lib/App/Easer/V2.pod view on Meta::CPAN
children => [
{
aliases => [ 'foo' ],
options => [ '+parent',
{
getopt => 'child-only',
help => 'option available in child only',
},
],
execute => sub ($self) {
say "foo says: ",
$self->config('transmittable') ? 'transmit' : 'no way';
},
},
],
};
Option C<transmittable> in the parent command can be inherited, while
C<parent-only> can not. Child command C<foo> does indeed inherit the
option, thanks to the C<+parent> option that allows inheriting
everything that the parent sets with a true C<transmit>.
t/V2/06.help-as-option.t view on Meta::CPAN
use Test::More;
use Test::Output;
use Test::Exception;
use App::Easer V2 => 'run';
sub execute ($cmd) {
return $cmd->run_help if $cmd->config('help');
if ($cmd->config('wrapped-help')) {
say 'BEGIN WRAPPING';
print $cmd->full_help_text;
say 'END WRAPPING';
return 0;
}
say 'normal call <', join('> <', $cmd->residual_args), '>';
return 0;
} ## end sub execute
my $app = {
help => 'example command',
description => 'An example command',
options => [
{
getopt => 'help|h!',
help => 'get some help about the command',
t/V2/22.custom-sources.t view on Meta::CPAN
sub custom_source_main ($instance, $opts, $args) {
my @opts = $opts->@*;
my %retval = (baz => $opts[0]);
$retval{bar} = $opts[0] unless $instance->config('bar');
$retval{three} = $opts[1] if @opts > 1;
return \%retval;
}
sub execute ($self) {
LocalTester::command_execute($self);
say 'whatever';
return 42;
}
package Foo;
use v5.24;
sub custom_source_foo ($instance, $opts, $args) {
return {
one => 'FIRST',
three => 'THIRD',
t/V2/24.hash-sources.t view on Meta::CPAN
my @stack;
my $instance = $self;
while (defined($instance)) {
my @args = $instance->residual_args;
my $ch = $instance->config_hash;
my $fch = $instance->_rwn('config') // {};
unshift @stack,
{ args => \@args, config => $ch, full_config => $fch };
$instance = $instance->parent;
}
say {*STDERR} "$phase $name " . $enc->encode(\@stack);
};
}
( run in 2.854 seconds using v1.01-cache-2.11-cpan-d7a12ab2c7f )