view release on metacpan or  search on metacpan

lib/App/MechaCPAN.pm  view on Meta::CPAN

  'help|h!',
);

# Timeout when there's no output in seconds
our $TIMEOUT = $ENV{MECHACPAN_TIMEOUT} // 60;
our $VERBOSE;    # Print output from sub commands to STDERR
our $QUIET;      # Do not print any progress to STDERR
our $LOGFH;      # File handle to send the logs to
our $LOG_ON = 1; # Default if to log or not
our $PROJ_DIR;   # The directory given with -d or pwd if not provided
our $CHKSIGS;    # Check signatures on/off/best attempt (undef)

# In certain blocks, you may see `no warnings 'uninitialized'`. Several subs
# end up doing a lot of work with comparisions that don't distinguish between
# undef and the empty string, so these warnings create more noise than useful
# feedback, and the code to silence them are not meaningfully better

sub main
{
  my @argv = @_;

  if ( $0 =~ m/zhuli/ )
  {
    no warnings 'uninitialized';

    if ( $argv[0] =~ m/^do the thing/i )
    {
      success( "zhuli$$", 'Running deployment' )
        unless $is_restarted_process;
      $argv[0] = 'deploy';
    }
    if ( $argv[0] =~ m/^do$/i
      && $argv[1] =~ m/^the$/i
      && $argv[2] =~ m/^thing$/i )
    {
      success( "zhuli$$", 'Running deployment' )
        unless $is_restarted_process;
      @argv = ( 'deploy', @argv[ 3 .. $#argv ] );
    }
  }

  my @args = (
    @App::MechaCPAN::args,
    @App::MechaCPAN::Perl::args,
    @App::MechaCPAN::Install::args,
    @App::MechaCPAN::Deploy::args,
  );
  @args = keys %{ { map { $_ => 1 } @args } };

  if ( !@argv )
  {
    my $prog = ( File::Spec->splitpath($0) )[2] || 'mechacpan';

    my @options = map {
      my ($names) = m/^([^=:!+]+)/;
      join( ', ', map { length > 1 ? "--$_" : "-$_" } split /\|/, $names );
    } @App::MechaCPAN::args;

    my $orig_fh = select STDERR;

    say "Usage: $prog [options] <command> [<args>]";
    say "";
    say "Commands:";
    say "  $_"
      foreach @commands;
    say "";
    say "Global Options:";
    say "  $_"
      foreach @options;
    say "";
    say "Run '$prog --help' for full documentation.";

    select $orig_fh;
    return -1;
  }

  my $options = {};
  my $getopt_ret
    = Getopt::Long::GetOptionsFromArray( \@argv, $options, @args );
  return -1
    if !$getopt_ret;

  if ( $options->{help} )
  {
    require Pod::Usage;
    Pod::Usage::pod2usage(
      -input   => $INC{ _inc_pkg(__PACKAGE__) },
      -verbose => 2,
      -exitval => 'NOEXIT',
      -output  => \*STDOUT,
    );
    return 0;
  }

  my $merge_options = sub
  {
    my $arg = shift;
    if ( ref $arg eq 'HASH' )
    {
      $options = { %$arg, %$options };
      return 0;
    }
    return 1;
  };

  @argv = grep { $merge_options->($_) } @argv;

  my $orig_dir = cwd;
  if ( exists $options->{directory} )
  {
    if ( !-d $options->{directory} )
    {
      die "Cannot find directory: $options->{directory}\n";
    }
    chdir $options->{directory};
  }

  # Once we've established the project directory, we need to attempt to
  # restart the script.
  &restart_script();

  local $PROJ_DIR = cwd;
  local $LOGFH;
  local $VERBOSE = $options->{verbose} // $VERBOSE;
  local $QUIET   = $options->{quiet}   // $QUIET;
  local $CHKSIGS = $options->{verify}  // $CHKSIGS;

  my $cmd;

  if ( $options->{'build-reusable-perl'} )
  {