view release on metacpan or  search on metacpan

lib/Applify.pm  view on Meta::CPAN

package Applify;
use strict;
use warnings;

use Carp           ();
use File::Basename ();
use Scalar::Util 'blessed';

use constant SUB_NAME_IS_AVAILABLE => $INC{'App/FatPacker/Trace.pm'}
  ? 0    # this will be true when running under "fatpack"
  : eval 'use Sub::Name; 1' ? 1 : 0;

our $INSTANTIATING = 0;
our $PERLDOC       = 'perldoc';
our $SUBCMD_PREFIX = 'command';
our $VERSION = '0.23';
my $ANON = 0;

sub app {
  my $self = shift;
  $self->{app} = shift if @_;

  # Activate sub command
  local @ARGV = @ARGV;
  shift @ARGV if $self->_subcommand_activate($ARGV[0]);

  my (%argv, @spec);
  $self->_run_hook(before_options_parsing => \@ARGV);

  for my $option (@{$self->options}, @{$self->_default_options}) {
    push @spec, $self->_calculate_option_spec($option);
    $argv{$option->{name}} = $option->{n_of} ? [] : undef;
  }

  my $got_valid_options = $self->option_parser->getoptions(\%argv, @spec);

  # Remove default $argv{foo} = [] and $argv{bar} = undef
  delete $argv{$_} for grep { !defined $argv{$_} || ref $argv{$_} eq 'ARRAY' && !@{$argv{$_}} } keys %argv;

  # Check if we should abort running the app based on user argv
  if (!$got_valid_options) {
    $self->_exit(1);
  }
  elsif ($argv{help}) {
    $self->print_help;
    $self->_exit('help');
  }
  elsif ($argv{man}) {
    system $PERLDOC => $self->documentation;
    $self->_exit($? >> 8);
  }
  elsif ($argv{version}) {
    $self->print_version;
    $self->_exit('version');
  }

  # Create the application and run (or return) it
  local $INSTANTIATING = 1;
  local $@;
  my $app = eval {
    $self->{application_class} ||= $self->_generate_application_class;
    $self->{application_class}->new(\%argv);
  } or do {
    $@ =~ s!\sat\s.*!!s unless $ENV{APPLIFY_VERBOSE};
    $self->print_help;
    local $! = 1;    # exit value
    die "\nInvalid input:\n\n$@\n";
  };

  return $app if defined wantarray;    # $app = do $script_file;
  $self->_exit($app->run(@ARGV));
}

sub documentation {
  return $_[0]->{documentation} if @_ == 1;
  $_[0]->{documentation} = $_[1] or die 'Usage: documentation $file|$module_name;';
  return $_[0];
}

sub extends {
  my $self = shift;
  $self->{extends} = [@_];
  return $self;
}