File Coverage

blib/lib/App/CLI/Extension.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	5	8	62.5
condition			n/a
subroutine	11	11	100.0
pod	2	3	66.6
total	78	83	93.9

package App::CLI::Extension;

=pod

=head1 NAME

App::CLI::Extension - for App::CLI extension module

=head1 VERSION

1.421

=head1 SYNOPSIS

  # MyApp.pm
  package MyApp;

  use strict;
  use base qw(App::CLI::Extension);

  # extension method
  # load App::CLI::Plugin::Foo,  MyApp::Plugin::Bar
  __PACKAGE__->load_plugins(qw(Foo +MyApp::Plugin::Bar));

  # extension method
  __PACKAGE__->config( name => "kurt" );

  1;

  # MyApp/Hello.pm
  package MyApp::Hello;

  use strict;
  use base qw(App::CLI::Command);
  use constant options => ("age=i" => "age");

  sub run {

      my($self, @args) = @_;
      # config - App::CLI::Extension extension method(App::CLI::Extension::Component::Config)
      print "Hello! my name is " . $self->config->{name} . "\n";
      print "age is " . "$self->{age}\n";
  }

  # myapp
  #!/usr/bin/perl

  use strict;
  use MyApp;

  MyApp->dispatch;

  # execute
  [kurt@localhost ~] myapp hello --age=27
  Hello! my name is kurt
  age is 27

=head1 DESCRIPTION

The expansion module which added plug in, initial setting mechanism to App::CLI

App::CLI::Extension::Component::* modules is automatic, and it is done require

(It is now Config and Stash is automatic, and it is done require)

=head2 RUN PHASE

  +----------------------+
  |   ** run_method **   |
  |  +----------------+  |
  |  |  setup  phase  |  |
  |  +----------------+  |
  |          ||          |
  |  +----------------+  |
  |  |  prerun phase  |  |
  |  +----------------+  |
  |          ||          |
  |  +----------------+  |   if anything error...   +----------------+
  |  |    run phase   |  |  ======================> |   fail  phase  |
  |  +----------------+  |                          +----------------+
  |          ||          |                       set exit_value(default: 255)
  |  +----------------+  |                                   |
  |  |  postrun phase |  |                                   |
  |  +----------------+  |                                   |
  +----------------------+                                   |
              |                                              |
              |                                              |
     +----------------+                                      |
     |  finish phase  |  <================================== +
     +----------------+
              |
             exit

=head2 SETUP

If you define initialization and initialization of each plug-in

=head2 PRERUN

If you want the process to run before you run something in the main processing

=head2 RUN

Process to define the main(require). however, $self->finished non-zero if not executed

=head2 POSTRUN

After the run method to execute. however, $self->finished non-zero if not executed

=head2 FINISH

At the end of all processing

=head2 FAIL

setup/prerun/run/postrun/finish processing to be executed if an exception occurs somewhere in the phase error

$self->e is the App::CLI::Extension::Exception or Error::Simple instance is set

=cut

use strict;
use warnings;
use base qw(App::CLI Class::Accessor::Grouped);
use 5.008000;
use UNIVERSAL::require;

our $VERSION    = '1.421';
our @COMPONENTS = qw(
					Config
					ErrorHandler
					InstallCallback
					OriginalArgv
					Stash
					RunCommand
                  );

__PACKAGE__->mk_group_accessors(inherited => "_config", "_components", "_orig_argv", "_plugins");
__PACKAGE__->_config({});
__PACKAGE__->_plugins([]);

=pod

=head1 METHOD

=cut

sub import {

	my $class = shift;
	my @loaded_components;
	foreach my $component (@COMPONENTS) {
		$component = sprintf "%s::Component::%s", __PACKAGE__, $component;
		$component->require or die "load component error: $UNIVERSAL::require::ERROR";
		$component->import;
		push @loaded_components, $component;
    }
	$class->_components(\@loaded_components);
}

sub dispatch {

	my $class = shift;
	# save original argv
	my @argv = @ARGV;
	$class->_orig_argv(\@argv);
	my $cmd = $class->prepare(@_);
	$cmd->subcommand;
	{
		no strict "refs"; ## no critic
		no warnings "uninitialized"; ## adhoc
		my $pkg = ref($cmd);
		# component and plugin set value
		unshift @{"$pkg\::ISA"}, @{$class->_components};
		if (scalar(@{$class->_plugins}) != 0) {
			unshift @{"$pkg\::ISA"}, @{$class->_plugins};
		}
		$cmd->config($class->_config);
		$cmd->orig_argv($class->_orig_argv);
	}
	$cmd->run_command(@ARGV);
}


=pod

=head2 load_plugins

auto load and require plugin modules

Example

  # MyApp.pm
  # MyApp::Plugin::GoodMorning and App::CLI::Plugin::Config::YAML::Syck require
  __PACKAGE__->load_plugins(qw(+MyApp::Plugin::GoodMorning Config::YAML::Syck));

  # MyApp/Plugin/GoodMorning.pm
  package MyApp::Plugin::GoodMorning;

  use strict;

  sub good_morning {

      my $self = shift;
      print "Good monring!\n";
  }

  # MyApp/Hello.pm
  package MyApp::Hello;

  use strict;
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      $self->good_morning;
  }

  # myapp
  #!/usr/bin/perl

  use strict;
  use MyApp;

  MyApp->dispatch;

  # execute
  [kurt@localhost ~] myapp hello
  Good morning!

=cut

sub load_plugins {

	my($class, @load_plugins) = @_;

	my @loaded_plugins = @{$class->_plugins};
	foreach my $plugin(@load_plugins){

		if ($plugin =~ /^\+/) {
			$plugin =~ s/^\+//;
		} else {
			$plugin = "App::CLI::Plugin::$plugin";
		}
		$plugin->require or die "plugin load error: $UNIVERSAL::require::ERROR";
		$plugin->import;
		push @loaded_plugins, $plugin;
	}

	$class->_plugins(\@loaded_plugins);
}

=pod

=head2 config

configuration method

Example

  # MyApp.pm
  __PACKAGE__->config(
                 name           => "kurt",
                 favorite_group => "nirvana",
                 favorite_song  => ["Lounge Act", "Negative Creep", "Radio Friendly Unit Shifter", "You Know You're Right"]
              );

  # MyApp/Hello.pm
  package MyApp::Hello;

  use strict;
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      print "My name is " . $self->config->{name} . "\n";
      print "My favorite group is " . $self->config->{favorite_group} . "\n";
      print "My favorite song is " . join(",", @{$self->config->{favorite_song}});
      print " and Smells Like Teen Spirit\n"
  }

  # myapp
  #!/usr/bin/perl

  use strict;
  use MyApp;

  MyApp->dispatch;

  # execute
  [kurt@localhost ~] myapp hello
  My name is kurt
  My favorite group is nirvana
  My favorite song is Lounge Act,Negative Creep,Radio Friendly Unit Shifter,You Know You're Right and Smells Like Teen Spirit

=cut

sub config {

	my($class, %config) = @_;
	$class->_config(\%config);
	return $class->_config;
}

=head1 COMPONENT METHOD

=head2 argv0

my script name

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;
  use strict;
  use feature ":5.10.0";
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      say "my script name is " . $self->argv0;
  }

  1;

  # execute
  [kurt@localhost ~] myapp hello
  my script name is myapp

=head2 full_argv0

my script fullname

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;
  use strict;
  use feature ":5.10.0";
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      say "my script full name is " . $self->full_argv0;
  }

  1;

  # execute
  [kurt@localhost ~] myapp hello
  my script name is /home/kurt/myapp

=head2 cmdline

my execute cmdline string

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;
  use strict;
  use feature ":5.10.0";
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      say "my script cmdline is [" . $self->cmdline . "]";
  }

  1;

  # execute
  [kurt@localhost ~] myapp hello --verbose --num=10
  my script cmdline is [/home/kurt/myapp hello --verbose --num=10]

=head2 orig_argv

my execute script original argv

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;
  use strict;
  use feature ":5.10.0";
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      say "my script original argv is [" join(", ", @{$self->orig_argv}) . "]";
  }

  1;

  # execute
  [kurt@localhost ~] myapp hello --verbose --num=10
  my script original argv is [hello,--verbose, --num=10]

=head2 stash

like global variable in Command package

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;
  use strict;
  use feature ":5.10.0";
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      $self->stash->{name} = "kurt";
      say "stash value: " . $self->stash->{name};
  }

  1;

=head2 new_callback

install new callback phase

Example:

  $self->new_callback("some_phase");
  # registered callback argument pattern
  $self->new_callback("some_phase", sub { $self = shift; "anything to do..." });

=head2 add_callback

install callback

Example:

  $self->add_callback("some_phase", sub { my $self = shift; say "some_phase method No.1" });
  $self->add_callback("some_phase", sub { my $self = shift; say "some_phase method No.1" });
  $self->add_callback("any_phase", sub {
                                     my($self, @args) = @_;
                                     say "any_phase args: @args";
                                  });

=cut

=head2 exec_callback

execute callback

Example:

  $self->execute_callback("some_phase");
  # some_phase method method No.1
  # some_phase method method No.2

  $self->execute_callback("any_phase", qw(one two three));
  # any_phase args: one two three

=head2 exists_callback

exists callback check

Example:

  if ($self->exists_callback("some_phase")) {
      $self->exec_callback("some_phase");
  } else {
      die "some_phase is not exists callback phase";
  }

=head2 exit_value

set exit value

Example:

  # program exit value is 1(ex. echo $?)
  $self->exit_value(1);

=head2 finished

setup or prepare phase and 1 set, run and postrun phase will not run. default 0

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;

  use strict;
  use base qw(App::CLI::Command);

  sub prerun {

      my($self, @args) = @_;
      $self->finished(1);
  }

  # non execute
  sub run {

      my($self, @args) = @_;
      print "hello\n";
  }

=head2 throw

raises an exception, fail phase transitions

Example:

  # MyApp/Hello.pm
  package MyApp::Hello;

  use strict;
  use base qw(App::CLI::Command);

  sub run {

      my($self, @args) = @_;
      my $file = "/path/to/file";
      open my $fh, "< $file" or $self->throw("can not open file:$file");
      while ( my $line = <$fh> ) {
          chomp $line;
          print "$line\n";
      }
      close $fh;
  }

  # transitions fail phase method
  sub fail {

      my($self, @args) = @_;
      # e is App:CLI::Extension::Exception instance
      printf "ERROR: %s", $self->e;
      printf "STACKTRACE: %s", $self->e->stacktrace;
  }

  # myapp
  #!/usr/bin/perl

  use strict;
  use MyApp;

  MyApp->dispatch;

  # execute
  [kurt@localhost ~] myapp hello
  ERROR: can not open file:/path/to/file at lib/MyApp/Throw.pm line 10.
  STACKTRACE: can not open file:/path/to/file at lib/MyApp/Throw.pm line 10
          MyApp::Throw::run('MyApp::Throw=HASH(0x81bd6b4)') called at /usr/lib/perl5/site_perl/5.8.8/App/CLI/Extension/Component/RunCommand.pm line 36
          App::CLI::Extension::Component::RunCommand::run_command('MyApp::Throw=HASH(0x81bd6b4)') called at /usr/lib/perl5/site_perl/5.8.8/App/CLI/Extension.pm line 177
          App::CLI::Extension::dispatch('MyApp') called at ./myapp line 7

when you run throw method, App::CLI::Extension::Exception instance that $self->e is set to.

App::CLI::Extension::Exception is the Error::Simple is inherited. refer to the to documentation of C

throw method without running CORE::die if you run the $self->e is the Error::Simple instance will be set

=head2 e

App::CLI::Extension::Exception or Error::Simple instance. There is a ready to use, fail phase only

=head1 RUN PHASE METHOD

=head2 setup

=head2 prerun

=head2 postrun

=head2 finish

program last phase. By default, the exit will be executed automatically, exit if you do not want the APPCLI_NON_EXIT environ valiable how do I set the (value is whatever)

=head2 fail

error phase. default exit value is 255. if you want to change exit_value, see exit_value manual

=cut

1;

__END__