libapp-cmd-perl 0.323-1 / usr / share / perl5 / App / Cmd / Setup.pm

use strict;
use warnings;
package App::Cmd::Setup;
{
  $App::Cmd::Setup::VERSION = '0.323';
}
# ABSTRACT: helper for setting up App::Cmd classes


use App::Cmd ();
use App::Cmd::Command ();
use App::Cmd::Plugin ();
use Carp ();
use Data::OptList ();
use String::RewritePrefix ();

# 0.06 is needed for load_optional_class
use Class::Load 0.06 qw();

use Sub::Exporter -setup => {
  -as     => '_import',
  exports => [ qw(foo) ],
  collectors => [
    -app     => \'_make_app_class',
    -command => \'_make_command_class',
    -plugin  => \'_make_plugin_class',
  ],
};

sub import {
  goto &_import;
}

sub _app_base_class { 'App::Cmd' }

sub _make_app_class {
  my ($self, $val, $data) = @_;
  my $into = $data->{into};

  $val ||= {};
  Carp::confess "invalid argument to -app setup"
    if grep { $_ ne 'plugins' } keys %$val;

  Carp::confess "app setup requested on App::Cmd subclass $into"
    if $into->isa('App::Cmd');

  $self->_make_x_isa_y($into, $self->_app_base_class);

  if ( ! Class::Load::load_optional_class( $into->_default_command_base ) ) {
    my $base = $self->_command_base_class;
    Sub::Install::install_sub({
      code => sub { $base },
      into => $into,
      as   => '_default_command_base',
    });
  }

  # TODO Check this is right. -- kentnl, 2010-12
  #
  #  my $want_plugin_base = $self->_plugin_base_class;
  my $want_plugin_base = 'App::Cmd::Plugin';

  my @plugins;
  for my $plugin (@{ $val->{plugins} || [] }) {
    $plugin = String::RewritePrefix->rewrite(
      {
        ''  => 'App::Cmd::Plugin::',
        '=' => ''
      },
      $plugin,
    );
    Class::Load::load_class( $plugin );
    unless( $plugin->isa( $want_plugin_base ) ){
        die "$plugin is not a " . $want_plugin_base;
    }
    push @plugins, $plugin;
  }

  Sub::Install::install_sub({
    code => sub { @plugins },
    into => $into,
    as   => '_plugin_plugins',
  });

  return 1;
}

sub _command_base_class { 'App::Cmd::Command' }

sub _make_command_class {
  my ($self, $val, $data) = @_;
  my $into = $data->{into};

  Carp::confess "command setup requested on App::Cmd::Command subclass $into"
    if $into->isa('App::Cmd::Command');

  $self->_make_x_isa_y($into, $self->_command_base_class);

  return 1;
}

sub _make_x_isa_y {
  my ($self, $x, $y) = @_;

  no strict 'refs';
  push @{"$x\::ISA"}, $y;
}

sub _plugin_base_class { 'App::Cmd::Plugin' }
sub _make_plugin_class {
  my ($self, $val, $data) = @_;
  my $into = $data->{into};

  Carp::confess "plugin setup requested on App::Cmd::Plugin subclass $into"
    if $into->isa('App::Cmd::Plugin');

  Carp::confess "plugin setup requires plugin configuration" unless $val;

  $self->_make_x_isa_y($into, $self->_plugin_base_class);

  # In this special case, exporting everything by default is the sensible thing
  # to do. -- rjbs, 2008-03-31
  $val->{groups} = [ default => [ -all ] ] unless $val->{groups};

  my @exports;
  for my $pair (@{ Data::OptList::mkopt($val->{exports}) }) {
    push @exports, $pair->[0], ($pair->[1] || \'_faux_curried_method');
  }

  $val->{exports} = \@exports;

  Sub::Exporter::setup_exporter({
    %$val,
    into => $into,
    as   => 'import_from_plugin',
  });

  return 1;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::Cmd::Setup - helper for setting up App::Cmd classes

=head1 VERSION

version 0.323

=head1 OVERVIEW

App::Cmd::Setup is a helper library, used to set up base classes that will be
used as part of an App::Cmd program.  For the most part you should refer to
L<the tutorial|App::Cmd::Tutorial> for how you should use this library.

This class is useful in three scenarios:

=over 4

=item when writing your App::Cmd subclass

Instead of writing:

  package MyApp;
  use base 'App::Cmd';

...you can write:

  package MyApp;
  use App::Cmd::Setup -app;

The benefits of doing this are mostly minor, and relate to sanity-checking your
class.  The significant benefit is that this form allows you to specify
plugins, as in:

  package MyApp;
  use App::Cmd::Setup -app => { plugins => [ 'Prompt' ] };

Plugins are described in L<App::Cmd::Tutorial> and L<App::Cmd::Plugin>.

=item when writing abstract base classes for commands

That is: when you write a subclass of L<App::Cmd::Command> that is intended for
other commands to use as their base class, you should use App::Cmd::Setup.  For
example, if you want all the commands in MyApp to inherit from MyApp::Command,
you may want to write that package like this:

  package MyApp::Command;
  use App::Cmd::Setup -command;

Do not confuse this with the way you will write specific commands:

  package MyApp::Command::mycmd;
  use MyApp -command;

Again, this form mostly performs some validation and setup behind the scenes
for you.  You can use C<L<base>> if you prefer.

=item when writing App::Cmd plugins

L<App::Cmd::Plugin> is a mechanism that allows an App::Cmd class to inject code
into all its command classes, providing them with utility routines.

To write a plugin, you must use App::Cmd::Setup.  As seen above, you must also
use App::Cmd::Setup to set up your App::Cmd subclass if you wish to consume
plugins.

For more information on writing plugins, see L<App::Cmd::Manual> and
L<App::Cmd::Plugin>.

=back

=head1 AUTHOR

Ricardo Signes <rjbs@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Ricardo Signes.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut