BEGIN { $INC{'App/MechaCPAN.pm'} = __FILE__ };
BEGIN { $INC{'App/MechaCPAN/Deploy.pm'} = __FILE__ };
BEGIN { $INC{'App/MechaCPAN/Install.pm'} = __FILE__ };
BEGIN { $INC{'App/MechaCPAN/Perl.pm'} = __FILE__ };
# line 1 "App/MechaCPAN.pm"
package App::MechaCPAN;

use v5.14;
use strict;
use Cwd qw/cwd/;
use Carp;
use Config;
use Symbol qw/geniosym/;
use autodie;
use Term::ANSIColor qw//;
use IPC::Open3;
use IO::Select;
use List::Util qw/first/;
use Scalar::Util qw/blessed openhandle/;
use File::Temp qw/tempfile tempdir/;
use File::Fetch;
use File::Spec qw//;
use Getopt::Long qw//;

use Exporter qw/import/;

BEGIN
{
  our @EXPORT_OK = qw/
    url_re git_re git_extract_re
    has_git has_updated_git min_git_ver
    can_https
    logmsg info success error
    dest_dir get_project_dir
    fetch_file inflate_archive
    humane_tmpname humane_tmpfile humane_tmpdir
    parse_cpanfile
    run restart_script
    rel_start_to_abs
    /;
  our %EXPORT_TAGS = ( go => [@EXPORT_OK] );
}

our $VERSION = '0.29';

require App::MechaCPAN::Perl;
require App::MechaCPAN::Install;
require App::MechaCPAN::Deploy;

my $loaded_at_compile;
my $restarted_key        = 'APP_MECHACPAN_RESTARTED';
my $is_restarted_process = delete $ENV{$restarted_key};
INIT
{
  $loaded_at_compile = 1;
}

$loaded_at_compile //= 0;

our @args = (
  'diag-run!',
  'verbose|v!',
  'quiet|q!',
  'no-log!',
  'directory|d=s',
);

# 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

sub main
{
  my @argv = @_;

  if ( $0 =~ m/zhuli/ )
  {
    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 } };

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

  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;

  my $cmd    = ucfirst lc shift @argv;
  my $pkg    = join( '::', __PACKAGE__, $cmd );
  my $action = eval { $pkg->can('go') };
  my $munge  = eval { $pkg->can('munge_args') };

  if ( !defined $action )
  {
    warn "Could not find action to run: $cmd\n";
    return -1;
  }

  if ( $options->{'diag-run'} )
  {
    warn "Would run '$cmd'\n";
    chdir $orig_dir;
    return 0;
  }

  $options->{is_restarted_process} = $is_restarted_process;

  if ( defined $munge )
  {
    @argv = $pkg->$munge( $options, @argv );
  }

  my $dest_dir = &dest_dir;
  if ( !-d $dest_dir )
  {
    mkdir $dest_dir;
  }

  _setup_log($dest_dir)
    unless $options->{'no-log'};

  local $@;
  my $ret = eval { $pkg->$action( $options, @argv ) || 0; };
  chdir $orig_dir;

  if ( !defined $ret )
  {
    error($@);
    return -1;
  }

  return $ret;
}

sub _git_str
{
  state $_git_str;

  if ( !defined $_git_str )
  {
    $_git_str = '';
    my $git_version_str = eval { run(qw/git --version/); };
    if ( defined $git_version_str )
    {
      ($_git_str) = $git_version_str =~ m/git version (\d+[.]\d+[.]\d+)/;
    }
  }

  return $_git_str;
}

sub min_git_ver
{
  return '1.7.7';
}

sub has_updated_git
{
  my $git_version_str = _git_str;
  if ($git_version_str)
  {
    use version 0.77;
    if ( version->parse($git_version_str) >= version->parse(min_git_ver) )
    {
      return 1;
    }
  }

  return;
}

sub has_git
{
  return _git_str && has_updated_git;
}

# Give a list of https-incapable File::Fetch methods when https is unavailable
sub _https_blacklist
{
  require Module::Load::Conditional;

  state $can_https
    = Module::Load::Conditional::can_load( modules => 'IO::Socket::SSL' );

  if ( !$can_https )
  {
    return qw/lwp httptiny httplite/;
  }

  return ();
}

sub can_https
{
  state $can_https;

  # track the blacklist for testing
  state $ff_blacklist;
  undef $can_https
    if $File::Fetch::BLACKLIST ne $ff_blacklist;

  if ( !defined $can_https )
  {
    my $test_url = 'https://get.mechacpan.us/latest';
    my $test_str = '';

    local $File::Fetch::WARN;
    local $@;

    my $ff = File::Fetch->new( uri => $test_url );
    return 0
      if !defined $ff;

    $ff_blacklist = $File::Fetch::BLACKLIST;

    # Make sure not to use methods that can't handle https
    local $File::Fetch::BLACKLIST = [ @$ff_blacklist, _https_blacklist ];
    $ff->scheme('http');
    $can_https = defined $ff->fetch( to => \$test_str );
  }

  return $can_https;
}

sub url_re
{
  state $url_re = qr[
    ^
    (?: ftp | http | https | file )
    : //
  ]xmsi;
  return $url_re;
}

sub git_re
{
  state $git_re = qr[
    ^ (?: git | ssh ) : [^:]
    |
    [.]git (?: @|$ )
  ]xmsi;
  return $git_re;
}

sub git_extract_re
{
  state $re = qr[
    ^
    (                   # git url capture
      .* ://
      (?: \w*@)?      # Might have an @ for user@url
      .*?               # Capture the rest
    )
    (?:                 # git commit id capture
      @
      ([^@]*)           # Evertyhing after @ is a commit_id
    )?
    $
  ]xmsi;

  return $re;
}

sub parse_cpanfile
{
  my $file = shift;

  state $sandbox_num = 1;

  my $result = { runtime => {} };

  $result->{current} = $result->{runtime};

  my $methods = {
    on => sub
    {
      my ( $phase, $code ) = @_;
      local $result->{current} = $result->{$phase} //= {};
      $code->();
    },
    feature => sub {...},
  };

  foreach my $type (qw/requires recommends suggests conflicts/)
  {
    $methods->{$type} = sub
    {
      my ( $module, $ver ) = @_;
      if ( $module eq 'perl' )
      {
        $result->{perl} = $ver;
        return;
      }
      $result->{current}->{$type}->{$module} = $ver;
    };
  }

  foreach my $phase (qw/configure build test author/)
  {
    $methods->{ $phase . '_requires' } = sub
    {
      my ( $module, $ver ) = @_;
      $result->{$phase}->{requires}->{$module} = $ver;
    };
  }

  my $code_fh;
  if ( !($code_fh = openhandle($file) ) )
  {
    open $code_fh, '<', $file;
  }
  my $code = do { local $/; <$code_fh> };

  my $pkg = __PACKAGE__ . "::Sandbox$sandbox_num";
  $sandbox_num++;

  foreach my $method ( keys %$methods )
  {
    no strict 'refs';
    *{"${pkg}::${method}"} = $methods->{$method};
  }

  local $@;
  my $sandbox = join(
    "\n",
    qq[package $pkg;],
    qq[no warnings;],
    qq[# line 1 "$file"],
    qq[$code],
    qq[return 1;],
  );

  my $no_error = eval $sandbox;

  croak $@
    unless $no_error;

  delete $result->{current};

  return $result;
}

sub humane_qr
{
  state $humane_re = qr[
    [.]
    \d{4} \d{2} \d{2}
    _
    \d{2} \d{2} \d{2}
    [.]
    \w{4}
  ]xmsi;

  return $humane_re;
}

sub humane_tmpname
{
  my $descr = shift;

  my @localtime = localtime;
  my $now       = sprintf(
    "%04d%02d%02d_%02d%02d%02d",
    $localtime[5] + 1900,
    $localtime[4] + 1,
    @localtime[ 3, 2, 1, 0 ]
  );

  return "mecha_$descr.$now.XXXX";
}

sub _mktmpdir
{
  my $proj_dir = _get_project_dir();
  my $tmp_dir
    = defined $proj_dir ? "$proj_dir/local/tmp" : File::Spec->tmpdir;

  mkdir $tmp_dir
    unless -d $tmp_dir;

  return $tmp_dir;
}

sub humane_tmpfile
{
  my $descr   = shift;
  my $tmp_dir = _mktmpdir;

  my $template = File::Spec->catdir( $tmp_dir, humane_tmpname($descr) );
  return File::Temp->new(TEMPLATE => $template);
}

sub humane_tmpdir
{
  my $descr   = shift;
  my $tmp_dir = _mktmpdir;

  my $template = File::Spec->catdir( $tmp_dir, humane_tmpname($descr) );
  return tempdir(
    TEMPLATE => $template,
    CLEANUP  => 1,
  );
}

sub _setup_log
{
  my $dest_dir = shift;

  my $log_dir = "$dest_dir/logs";
  mkdir $log_dir
    unless -d $log_dir;

  my $proj_dir = &_get_project_dir;
  my $template = File::Spec->catdir( $log_dir, humane_tmpname('log') );
  my $log_path;
  ( $LOGFH, $log_path ) = tempfile( $template, UNLINK => 0 );
  $log_path =~ s[^\Q$proj_dir\E/?][];
  info("logging to '$log_path'...\n");
}

sub logmsg
{
  my @lines = @_;

  return
    unless defined $LOGFH;

  foreach my $line (@lines)
  {
    if ( $line !~ m/\n$/xms )
    {
      $line .= "\n";
    }
    print $LOGFH $line;
  }

  return;
}

sub info
{
  my $key  = shift;
  my $line = shift;

  if ( !defined $line )
  {
    $line = $key;
    undef $key;
  }

  status( $key, 'YELLOW', $line );
}

sub success
{
  my $key  = shift;
  my $line = shift;

  if ( !defined $line )
  {
    $line = $key;
    undef $key;
  }

  status( $key, 'GREEN', $line );
}

sub error
{
  my $key  = shift;
  my $line = shift;

  if ( !defined $line )
  {
    $line = $key;
    undef $key;
  }

  status( $key, 'RED', $line );
}

my $RESET = Term::ANSIColor::color('RESET');
my $BOLD  = Term::ANSIColor::color('BOLD');

sub _show_line
{
  my $key   = shift;
  my $color = shift;
  my $line  = shift;

  # If the color starts with red, it's an error and we should not touch it,
  # otherwise, we should clean up the line
  state $ERR_COLOR = Term::ANSIColor::color('RED');
  if ( $color !~ m/^\Q$ERR_COLOR/ )
  {
    $line =~ s/\n/ /xmsg;
  }

  state @key_lines;

  my $idx = first { $key_lines[$_] eq $key } 0 .. $#key_lines;

  if ( !defined $key )
  {
    # Scroll Up 1 line
    print STDERR "\n";
    $idx = -1;
  }

  if ( !defined $idx )
  {
    unshift @key_lines, $key;
    $idx = 0;

    # Scroll Up 1 line
    print STDERR "\n";
  }
  $idx++;

  # Don't bother with fancy line movements if we are verbose
  if ($VERBOSE)
  {
    print STDERR "$color$line$RESET\n";
    return;
  }

  # We use some ANSI escape codes, so they are:
  # \e[.F  - Move up from current line, which is always the end of the list
  # \e[K   - Clear the line
  # $color - Colorize the text
  # $line  - Print the text
  # $RESET - Reset the colorize
  # \e[.E  - Move down from the current line, back to the end of the list
  print STDERR "\e[${idx}F";
  print STDERR "\e[K";
  print STDERR "$color$line$RESET\n";
  print STDERR "\e[" . ( $idx - 1 ) . "E"
    if $idx > 1;

  return;
}

sub status
{
  my $key   = shift;
  my $color = shift;
  my $line  = shift;

  if ( !defined $line )
  {
    $line  = $color;
    $color = 'RESET';
  }

  logmsg($line);

  return
    if $QUIET;

  $color = eval { Term::ANSIColor::color($color) } // $RESET;

  state @last_key;

  # Undo the last line that is bold
  if ( @last_key && !$VERBOSE && $last_key[0] ne $key )
  {
    _show_line(@last_key);
  }

  _show_line( $key, $color . $BOLD, $line );

  @last_key = ( $key, $color, $line );
}
END  { print STDERR "\n" unless $QUIET; }
INIT { print STDERR "\n" unless $QUIET; }

sub _get_project_dir
{
  my $result = $PROJ_DIR;

  return $result;
}

sub get_project_dir
{
  my $result = _get_project_dir;

  if ( !defined $result )
  {
    $result = cwd;

    $result =~ s{ / local /? $}{}xms;
  }

  return $result;
}

package MechaCPAN::DestGuard
{
  use Cwd qw/cwd/;
  use Scalar::Util qw/refaddr weaken/;
  use overload '""' => sub { my $s = shift; return $$s }, fallback => 1;
  my $dest_dir;

  sub get
  {
    my $result = $dest_dir;
    if ( !defined $result )
    {
      my $pwd = App::MechaCPAN::get_project_dir;
      $dest_dir = \"$pwd/local";
      bless $dest_dir;
      $result = $dest_dir;
      weaken $dest_dir;
    }

    mkdir $dest_dir
      unless -d $dest_dir;

    return $dest_dir;
  }

  sub DESTROY
  {
    undef $dest_dir;
  }
}

sub dest_dir
{
  my $result = MechaCPAN::DestGuard::get();
  return $result;
}

sub fetch_file
{
  my $url = shift;
  my $to  = shift;

  use File::Copy qw/copy/;
  use Fatal qw/copy/;

  my $proj_dir = &dest_dir;
  my $slurp;

  local $File::Fetch::WARN;
  local $@;

  my $ff = File::Fetch->new( uri => $url );
  $ff->scheme('http')
    if $ff->scheme eq 'https';

  if ( ref $to eq 'SCALAR' )
  {
    $slurp = $to;
    undef $to;
  }

  my ( $dst_path, $dst_file, $result );
  if ( !defined $to )
  {
    $result = humane_tmpfile( $ff->output_file );

    my @splitpath = File::Spec->splitpath( $result->filename );
    $dst_path = File::Spec->catpath( @splitpath[ 0 .. 1 ] );
    $dst_file = $splitpath[2];
  }
  else
  {
    if ( $to =~ m[/$] )
    {
      $dst_path = $to;
      $dst_file = $ff->output_file;
    }
    else
    {
      my @splitpath = File::Spec->splitpath("$to");
      $dst_path = File::Spec->catpath( @splitpath[ 0 .. 1 ] );
      $dst_file = $splitpath[2];
    }

    $dst_path = File::Spec->rel2abs( $dst_path, "$proj_dir" )
      unless File::Spec->file_name_is_absolute($dst_path);
    $result = File::Spec->catdir( $dst_path, $dst_file );
  }

  mkdir $dst_path
    unless -d $dst_path;

  my $where = $ff->fetch( to => $dst_path );

  if ( !defined $where )
  {
    my $tmpfile = File::Spec->catdir( $dst_path, $ff->output_file );
    if ( -e $tmpfile && !-s )
    {
      unlink $tmpfile;
    }
    die $ff->error || "Could not download $url";
  }

  if ( $where ne $result )
  {
    copy( $where, $result );
    $result->seek( 0, 0 )
      if fileno $result;
    unlink $where;
  }

  if ( defined $slurp )
  {
    open my $slurp_fh, '<', $result;
    $$slurp = do { local $/; <$slurp_fh> };
    $result->seek( 0, 0 )
      if fileno $result;
  }

  return $result;
}

my @inflate = (

  # System tar
  sub
  {
    my $src = shift;

    my $humane_qr = humane_qr;
    return
      unless $src =~ m{ [.]tar[.] (?: gz | bz2 | xz ) $humane_qr? $}xms;

    state $tar;
    if ( !defined $tar )
    {
      my $tar_version_str = eval { run(qw/tar --version/); };
      $tar = defined $tar_version_str;
    }

    return
      unless $tar;

    my $unzip
      = $src =~ m/gz $humane_qr? $/xms          ? 'gzip'
      : $src =~ m/(bz2|bzip2) $humane_qr? $/xms ? 'bzip2'
      :                                           'xz';

    run("$unzip -dc $src | tar xf -");
    return 1;
    },

  # Archive::Tar
  sub
  {
    my $src = shift;

    require Archive::Tar;
    my $tar = Archive::Tar->new;
    $tar->error(1);

    my $ret = $tar->read( "$src", 1, { extract => 1 } );

    die $tar->error
      unless $ret;
  },
);

sub inflate_archive
{
  my $src = shift;
  my $dir = shift;

  # $src can be a file path or a URL.
  if ( !-e "$src" )
  {
    $src = fetch_file($src);
  }

  if ( !defined $dir )
  {
    my $descr = ( File::Spec->splitpath($src) )[2];
    $dir = humane_tmpdir($descr);
  }

  die "Could not find destination directory: $dir"
    if !-d $dir;

  my $orig = cwd;

  my $is_complete;
  foreach my $inflate_sub (@inflate)
  {
    local $@;
    my $success;
    my $error_free = eval {
      chdir $dir;
      $success = $inflate_sub->($src);
      1;
    };

    my $err = $@;
    my @glob = glob('*');

    chdir $orig;

    logmsg $err
      unless $error_free;

    if ($success && @glob > 0)
    {
      $is_complete = 1;
      last;
    }
  }

  if ( !$is_complete )
  {
    croak "Could not unpack archive: $src\n";
  }

  # If there's only 1 file and it's a directory, go ahead and chdir into it
  my @files = glob("$dir/*");
  if ( @files == 1 && -d $files[0] )
  {
    $dir = $files[0];
  }

  return $dir;
}

sub _genio
{
  state $iswin32 = $^O eq 'MSWin32';
  my $write_hdl;
  my $read_hdl;

  if ($iswin32)
  {
    use Socket;
    socketpair( $read_hdl, $write_hdl, AF_UNIX, SOCK_STREAM, PF_UNSPEC );
    shutdown( $read_hdl,  1 );
    shutdown( $write_hdl, 0 );
  }
  else
  {
    $write_hdl = $read_hdl = geniosym;
  }

  $write_hdl->blocking(0);
  $write_hdl->autoflush(1);
  $read_hdl->blocking(0);
  $read_hdl->autoflush(1);

  return ( $read_hdl, $write_hdl );
}

sub run
{
  my $cmd  = shift;
  my @args = @_;

  my $max_lines = 15;
  my $out = "";
  my $err = "";
  my @err_tail;
  my @out_tail;

  my $dest_out_fh  = $LOGFH;
  my $dest_err_fh  = $LOGFH;
  my $print_output = $VERBOSE;
  my $wantoutput   = defined wantarray;

  if ( ref $cmd eq 'GLOB' || ( blessed $cmd && $cmd->isa('IO::Handle') ) )
  {
    $dest_out_fh = $cmd;
    $cmd         = shift @args;
    undef $print_output;
  }

  # If the output is asked for (non-void context), don't show it anywhere
  #<<<
  if ($wantoutput)
  {
    undef $dest_out_fh; open $dest_out_fh, ">", \$out;
    undef $dest_err_fh; open $dest_err_fh, ">", \$err;
    undef $print_output;
  }
  #>>>

  my ( $output, $output_chld ) = _genio;
  my ( $error,  $error_chld )  = _genio;

  warn( join( "\t", $cmd, @args ) . "\n" )
    if $VERBOSE;

  print $dest_err_fh ( 'Running: ', join( "\t", $cmd, @args ) . "\n" )
    if defined $dest_err_fh;

  my $pid = open3(
    undef,
    $output_chld->fileno ? '>&' . $output_chld->fileno : $output_chld,
    $error_chld->fileno  ? '>&' . $error_chld->fileno  : $error_chld,
    $cmd, @args
  );
  undef $output_chld;
  undef $error_chld;

  my $select = IO::Select->new;

  $select->add( $output, $error );

  my $alrm_code = "TIMEOUT\n";
  local $SIG{ALRM} = sub { die $alrm_code };
  local $@;

  eval {
    alarm $TIMEOUT;
    while ( my @ready = $select->can_read )
    {
      alarm $TIMEOUT;
      foreach my $fh (@ready)
      {
        my $line = <$fh>;

        if ( !defined $line )
        {
          $select->remove($fh);
          next;
        }

        print STDERR $line if $print_output;

        if ( $fh eq $output )
        {
          print $dest_out_fh $line
            if defined $dest_out_fh;
          if ( !$wantoutput )
          {
            $out .= $line;
            unshift @out_tail, $line;
            $#out_tail = $max_lines
              if $#out_tail > $max_lines;
          }
        }

        if ( $fh eq $error )
        {
          print $dest_err_fh $line
            if defined $dest_err_fh;
          if ( !$wantoutput )
          {
            $err .= $line;
            unshift @err_tail, $line;
            $#err_tail = $max_lines
              if $#err_tail > $max_lines;
          }
        }

      }
    }
  };

  my $error = $@;
  alarm 0;

  if ( $error eq $alrm_code )
  {
    info "Idle timeout (${TIMEOUT}s) exceeded, killing";
    kill "KILL", $pid;
  }

  waitpid( $pid, 0 );

  if ($?)
  {
    my $code = qq/Exit Code: / . ( $? >> 8 );
    my $sig  = ( $? & 127 ) ? qq/Signal: / . ( $? & 127 ) : '';
    my $core = $? & 128     ? 'Core Dumped'               : '';

    # There could be a lot of output, ignore all but the very end
    @out_tail[-1] = "...SKIPPED\n"
      if scalar @out_tail > $max_lines;
    my $out_tail = join( '', reverse @out_tail );
    chomp $out_tail;

    @err_tail[-1] = "...SKIPPED\n"
      if scalar @err_tail > $max_lines;
    my $err_tail = join( '', reverse @err_tail );
    chomp $err_tail;

    croak ""
      . Term::ANSIColor::color('RED')
      . qq/\nCould not execute '/
      . join( ' ', $cmd, @args ) . qq/'/
      . qq/\nPID: $pid/
      . qq/\t$code/
      . qq/\t$sig/
      . qq/\t$core/
      . Term::ANSIColor::color('GREEN')
      . qq/\n$out_tail/
      . Term::ANSIColor::color('YELLOW')
      . qq/\n$err_tail/
      . Term::ANSIColor::color('RESET') . "\n";
  }

  return
    if !defined wantarray;

  if (wantarray)
  {
    return split( /\r?\n/, $out );
  }

  return $out;
}

# Install App::MechaCPAN into a local perl, either by ::Install or copy
sub _inc_pkg
{
  my $inc_name = ( shift || __PACKAGE__ ) . '.pm';
  $inc_name =~ s{::}{/}g;
  return $inc_name;
}

my $starting_cwd;
BEGIN { $starting_cwd = cwd }

sub rel_start_to_abs
{
  my $f = shift;

  $f = File::Spec->rel2abs( $f, $starting_cwd )
    unless File::Spec->file_name_is_absolute($f);

  return $f;
}

sub self_install
{
  my $real0 = shift;

  my $dest_dir = &dest_dir;
  my $dest_lib = File::Spec->catdir( "$dest_dir", qw/lib perl5/ );
  my $dest_app = File::Spec->catdir( "$dest_dir", qw/bin/ );
  my $inc_name = _inc_pkg;

  return
    if !-d $dest_dir;

  # Return if there's already a copy
  return
    if -e File::Spec->catdir( $dest_lib, $inc_name );

  use File::Copy qw/copy/;
  use File::Path qw/make_path/;
  use Fatal qw/copy/;

  make_path $dest_lib, $dest_app;

  if ( defined $real0 && -e $real0 )
  {
    # Attempt to find the full path to this file.
    my $mecha_path;

    foreach my $lib (@INC)
    {
      my $mecha_file
        = rel_start_to_abs( File::Spec->catdir( $lib, $inc_name ) );
      if ( -e $mecha_file )
      {
        $mecha_path = rel_start_to_abs $lib;
        last;
      }
    }

    if ( defined $mecha_path )
    {
      $inc_name =~ s/[.]pm$//;
      my %copy_list;
      foreach my $k ( grep {m/$inc_name/} keys %INC )
      {
        my $src = File::Spec->catdir( $mecha_path, $k );
        my $dst = File::Spec->catdir( $dest_lib,   $k );

        my $dst_path
          = File::Spec->catpath( ( File::Spec->splitpath($dst) )[ 0 .. 1 ] );
        make_path $dst_path;

        if ( !-e $src )
        {
          %copy_list = ();
          last;
        }
        $copy_list{$src} = $dst;
      }

      if ( keys %copy_list )
      {
        while ( my ( $src, $dst ) = each %copy_list )
        {
          copy $src => $dst;
        }
        copy $real0 => $dest_app;
        return;
      }
    }
  }

  # We don't check the result because we are going to continue even if
  # the install fails
  info "Installing " . __PACKAGE__;
  App::MechaCPAN::Install->go( {}, __PACKAGE__ );
  return;
}

sub restart_script
{
  my $dest_dir   = &dest_dir;
  my $local_perl = File::Spec->canonpath("$dest_dir/perl/bin/perl");
  my $this_perl  = File::Spec->canonpath($^X);
  my $cwd        = cwd;

  if ( $^O ne 'VMS' )
  {
    $this_perl .= $Config{_exe}
      unless $this_perl =~ m/$Config{_exe}$/i;
    $local_perl .= $Config{_exe}
      unless $local_perl =~ m/$Config{_exe}$/i;
  }

  return
    if $local_perl eq $this_perl;

  my $real0 = rel_start_to_abs $0;

  if ( !-e -r $real0 )
  {
    logmsg "Could not find '$0', not in '$starting_cwd' nor pwd '$cwd'";
    info "Could not find '$0' in order to restart script";
    return;
  }

  if (
    $loaded_at_compile      # IF we were loaded during compile-time
    && -e -x $local_perl    # AND the local perl is there
    && -e -f -r $real0      # AND we are a readable file
    && !$^P                 # AND we're not debugging
    )
  {
    # ReExecute using the local perl
    my @inc_add;
    my @paths = qw/
      sitearchexp sitelibexp
      vendorarchexp vendorlibexp
      archlibexp privlibexp
      otherlibdirsexp
      /;
    my %site_inc = map { $_ => 1 } @Config{@paths}, '.';

    foreach my $lib ( split ':', $ENV{PERL5LIB} )
    {
      $site_inc{$lib} = 1;
      $site_inc{"$lib/$Config{archname}"} = 1;
    }

    # If we are not a self-contained script, we should call self_install to
    # make sure we are installed, by hook or by crook
    if ( $INC{&_inc_pkg} =~ m/MechaCPAN[.]pm/ )
    {
      self_install($real0);
    }

    foreach my $lib (@INC)
    {
      push( @inc_add, $lib )
        unless exists $site_inc{$lib};
    }

    # Make sure anything from PERL5LIB and local::lib are removed since it's
    # most likely the wrong version as well.
    @inc_add = grep { $_ !~ m/^$ENV{PERL_LOCAL_LIB_ROOT}/xms } @inc_add;
    undef @ENV{qw/PERL_LOCAL_LIB_ROOT PERL5LIB/};

    # If we've running, inform the new us that they are a restarted process
    local $ENV{$restarted_key} = 1
      if ${^GLOBAL_PHASE} eq 'RUN';

    # Cleanup any files opened already. They arn't useful after we exec
    File::Temp::cleanup();

    info "Restarting to local perl\n";
    info( join( " ", $local_perl, map( {"-I$_"} @inc_add ), $real0, @ARGV ) );
    exec( $local_perl, map( {"-I$_"} @inc_add ), $real0, @ARGV );
  }
}

1;
# line 1 "App/MechaCPAN/Deploy.pm"
package App::MechaCPAN::Deploy;

use strict;
use warnings;
use autodie;
use Carp;
use CPAN::Meta;
use List::Util qw/first reduce/;
use App::MechaCPAN qw/:go/;

our @args = (
  'skip-perl!',
  'update!',
);

sub munge_args
{
  my $class = shift;
  my $opts  = shift;
  my $file  = shift || '.';

  if ( $file =~ git_re )
  {
    my ( $git_url, $branch ) = $file =~ git_extract_re;

    if ( !eval { run(qw/git --version/); 1; } )
    {
      croak "Was given a git-looking URL, but could not run git";
    }

    my $remote      = 'origin';
    my $needs_clone = 1;

    # Determine if we're in a git directory
    if ( -d '.git' || eval { run(qw/git rev-parse --git-dir/); 1 } )
    {
      my $remote_line = first {m/\t $git_url \s/xms} run(qw/git remote -v/);
      if ($remote_line)
      {
        ($remote) = $remote_line =~ m/^ ([^\t]*) \t/xms;

        success "Found git checkout of of $git_url";

        $needs_clone = 0;
      }
      elsif ( -d '.git' )
      {
        # Only croak if there is a .git here which means we can't clone here
        croak "Found git checkout but could not find remote URL $git_url";
      }
    }

    if ($needs_clone)
    {
      info 'git-clone', "Cloning $git_url";

      my ($descr) = $git_url =~ m{ ([^/]*) $}xms;
      my $dir = humane_tmpdir($descr);

      # We use a temp directory and --seperate-git-dir  since byt his point
      # local exists because we're created it and started logging. These
      # options, plus the git config below, allow us to clone a git repo
      # without a clean current directory.
      run qw/git clone/, '--separate-git-dir=.git', '-n', '-o', $remote,
        $git_url, $dir;
      run qw/git config --unset core.worktree/;
      $branch //= 'master';
      success 'git-clone', "Cloned $git_url";
    }

    if ($branch)
    {
      info 'git-branch', "Checking out $branch";
      run qw/git checkout/, $branch;
      run qw/git fetch/, $remote, $branch;
      info 'git-branch', "Merging with remote branch $remote/$branch";
      run qw/git merge --ff-only FETCH_HEAD/;
      success 'git-branch', "Switched branch to $remote/$branch";
    }

    if ( !-f 'cpanfile' )
    {
      my @cpanfiles = glob '*/cpanfile';
      if ( scalar @cpanfiles == 1 )
      {
        my $dir = $cpanfiles[0];
        $dir =~ s[/cpanfile$][]xms;
        chdir $dir;
        $file = 'cpanfile';
      }
    }
  }

  return ($file);
}

sub go
{
  my $class = shift;
  my $opts  = shift;
  my $file  = shift || '.';

  if ( -d $file )
  {
    $file = "$file/cpanfile";
  }

  if ( !-e $file )
  {
    croak "Could not find cpanfile ($file)";
  }

  if ( !-f $file )
  {
    croak "cpanfile must be a regular file";
  }

  my $prereq = parse_cpanfile($file);
  my @phases = qw/configure build test runtime/;

  my @acc = map {%$_} map { values %{ $prereq->{$_} } } @phases;
  my @reqs;
  while (@acc)
  {
    push @reqs, [ splice( @acc, 0, 2 ) ];
  }

  if ( -f "$file.snapshot" )
  {
    my $snapshot_info = parse_snapshot("$file.snapshot");
    my %srcs;
    my %reqs;
    foreach my $dist ( values %$snapshot_info )
    {
      my $src = $dist->{pathname};
      foreach my $provide ( keys %{ $dist->{provides} } )
      {
        if ( exists $srcs{$provide} )
        {
          error "Found duplicate distribution for $provide in $file.snapshot";
          info "  $src and $srcs{$provide} both provide the same module";
          info "  This will cause an error if it is used as a dependency";
          $srcs{$provide} = undef;
          next;
        }
        $srcs{$provide} = $src;
      }

      foreach my $req ( keys %{ $dist->{requirements} } )
      {
        $reqs{$req} = undef;
      }
    }

    if ( ref $opts->{source} eq 'HASH' )
    {
      %srcs = ( %srcs, %{ $opts->{source} } );
    }
    $opts->{source}         = { %reqs, %srcs };
    $opts->{update}         = 0;
    $opts->{'only-sources'} = 1;
    $opts->{'smart-tests'}  = 1
      if !defined $opts->{'smart-tests'};
  }

  my $result;
  $opts->{update} //= 0;

  if ( !$opts->{'skip-perl'} )
  {
    $result = App::MechaCPAN::Perl->go($opts);
    return $result if $result;
  }

  $result = App::MechaCPAN::Install->go( $opts, @reqs );
  return $result if $result;

  return 0;
}

my $snapshot_re = qr/^\# carton snapshot format: version 1\.0/;

sub parse_snapshot
{
  my $file = shift;

  my $result = {};

  open my $snap_fh, '<', $file;

  if ( my $line = <$snap_fh> !~ $snapshot_re )
  {
    die "File doesn't looks like a carton snapshot: $file";
  }

  my @stack  = ($result);
  my $prefix = '';
  while ( my $line = <$snap_fh> )
  {
    chomp $line;

    if ( $line =~ m/^ \Q$prefix\E (\S+?) :? $/xms )
    {
      my $new_depth = {};
      $stack[0]->{$1} = $new_depth;
      unshift @stack, $new_depth;
      $prefix = '  ' x $#stack;
      next;
    }

    if ( $line =~ m/^ \Q$prefix\E (\S+?) (?: :? \s (.*) )? $/xms )
    {
      $stack[0]->{$1} = $2;
      next;
    }

    if ( $line !~ m/^ \Q$prefix\E /xms )
    {
      shift @stack;
      $prefix = '  ' x $#stack;
      redo;
    }

    die "Unable to parse snapshot (line $.)\n";
  }

  return $result->{DISTRIBUTIONS};
}

1;
# line 1 "App/MechaCPAN/Install.pm"
package App::MechaCPAN::Install;

use v5.14;

use Carp;
use Config;
use Cwd qw/cwd/;
use JSON::PP qw//;
use File::Spec qw//;
use File::Path qw//;
use CPAN::Meta qw//;
use CPAN::Meta::Prereqs qw//;
use Module::CoreList;
use ExtUtils::MakeMaker qw//;
use App::MechaCPAN qw/:go/;

our @args = (
  'skip-tests!',
  'skip-tests-for:s@',
  'smart-tests!',
  'install-man!',
  'source=s%',
  'only-sources!',
  'update!',
  'stop-on-error!',
);

our $dest_lib;

# Constants
my $COMPLETE = 'COMPLETE';
my $FAILED   = 'FAILED';

sub go
{
  my $class = shift;
  my $opts  = shift;
  my $src   = shift // '.';
  my @srcs  = @_;

  my $orig_dir = cwd;
  my $dest_dir = &dest_dir;

  local $dest_lib = "$dest_dir/lib/perl5";

  my @targets = ( $src, @srcs );
  my %src_names;
  my @deps;

  if ( ref $opts->{source} ne 'HASH' && ref $opts->{source} ne 'CODE' )
  {
    $opts->{source} = {};
  }

  if ( ref $opts->{'skip-tests-for'} ne 'ARRAY' )
  {
    $opts->{'skip-tests-for'} = [];
  }
  $opts->{'skip-tests-for'}
    = { map { $_ => 1 } @{ $opts->{'skip-tests-for'} } };

  my $unsafe_inc
    = exists $ENV{PERL_USE_UNSAFE_INC} ? $ENV{PERL_USE_UNSAFE_INC} : 1;

  # trick AutoInstall
  local $ENV{PERL5_CPAN_IS_RUNNING}     = $$;
  local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;

  local $ENV{PERL_MM_USE_DEFAULT} = 1;
  local $ENV{PERL_USE_UNSAFE_INC} = $unsafe_inc;

  local $ENV{PERL_MM_OPT} = "INSTALL_BASE=$dest_dir";
  local $ENV{PERL_MB_OPT} = "--install_base $dest_dir";

  local $ENV{PERL5LIB} = "$dest_lib";

  # skip man page generation
  if ( !$opts->{'install-man'} )
  {
    $ENV{PERL_MM_OPT}
      .= " " . join( " ", "INSTALLMAN1DIR=none", "INSTALLMAN3DIR=none" );
    $ENV{PERL_MB_OPT} .= " " . join(
      " ",                            "--config installman1dir=",
      "--config installsiteman1dir=", "--config installman3dir=",
      "--config installsiteman3dir="
    );
  }

  #if ( $self->{pure_perl} )
  #{
  #  $ENV{PERL_MM_OPT} .= " PUREPERL_ONLY=1";
  #  $ENV{PERL_MB_OPT} .= " --pureperl-only";
  #}

  my $cache = { opts => $opts };

  # Prepopulate all of the sources as targets
  foreach my $source_key ( keys %{ $opts->{source} } )
  {
    my $source = $opts->{source}->{$source_key};

    # If there is no source to translate to, continue
    if ( !defined $source )
    {
      _create_target( $source_key, $cache );
      next;
    }

    # If we can find a target, reuse it, otherwise create a new one
    my $target = _find_target( $source, $cache );
    if ( defined $target )
    {
      _alias_target( $target, $source_key, $cache );
    }
    else
    {
      $target = _create_target( $source_key, $cache );
      _alias_target( $target, $source, $cache );
    }
  }

  my @full_states = (
    'Resolving'     => \&_resolve,
    'Configuring'   => \&_meta,
    'Configuring'   => \&_config_prereq,
    'Configuring'   => \&_configure,
    'Configuring'   => \&_mymeta,
    'Prerequisites' => \&_prereq,
    'Prerequisites' => \&_test_prereq,
    'Prerequisites' => \&_prereq_verify,
    'Building'      => \&_build,
    'Testing'       => \&_test,
    'Installing'    => \&_install,
    'Installed'     => \&_write_meta,
  );

  my @states     = grep { ref $_ eq 'CODE' } @full_states;
  my @state_desc = grep { ref $_ ne 'CODE' } @full_states;

  @targets
    = map { _create_inital_target( $_, $cache, $opts->{update} ) } @targets;

TARGET:
  while ( my $target = shift @targets )
  {
    $target = _create_target( $target, $cache );

    if ( $target->{state} eq $COMPLETE || $target->{state} eq $FAILED )
    {
      next;
    }

    chdir $orig_dir;
    chdir $target->{dir}
      if exists $target->{dir};

    my $line = _target_line( $target, $state_desc[ $target->{state} ] );
    info( $target->{key}, $line );
    my $method = $states[ $target->{state} ];

    {
      local $@;
      my $succ = eval { unshift @targets, $method->( $target, $cache ); 1; };
      my $err = $@;

      if ( !$succ )
      {
        my $line = sprintf(
          '%-13s %s', 'Error',
          "Could not install " . _name_target($target)
        );

        logmsg( $target->{key}, $err );
        error( $target->{key}, $line );

        _failed($target);

        if ( $opts->{'stop-on-error'} )
        {
          croak $err;
        }

        next TARGET;
      }
    }

    $target->{state}++
      if $target->{state} ne $COMPLETE;

    if ( $target->{state} eq scalar @states )
    {
      _complete($target);
      $target->{was_installed} = 1;
      success( $target->{key}, $line );
    }
  }

  chdir $orig_dir;

  my %attempted = map  { $_->{name} => $_ } values %{ $cache->{targets} };
  my @failed    = grep { $_->{state} eq $FAILED } values %attempted;
  my @installed = grep { $_->{was_installed} } values %attempted;

  success "\tsuccess", "Installed " . scalar @installed . " modules";

  if ( @failed > 0 )
  {
    logmsg "Failed modules: " . join( ", ", @failed );
    die "Failed to install " . scalar @failed . " modules\n";
  }

  return 0;
}

sub _resolve
{
  my $target = shift;
  my $cache  = shift;

  # Verify we need to install it
  return
    if !_should_install($target);

  my $src_name = $target->{src_name};

  $target->{src_name} = _source_translate( $src_name, $cache->{opts} );

  # fetch
  my $src_tgz = _get_targz($target);

  return
    if !_should_install($target);

  my $src_dir = inflate_archive($src_tgz);

  @{$target}{qw/src_tgz dir was_installed/} = ( $src_tgz, $src_dir, 0 );
  return $target;
}

sub _meta
{
  my $target = shift;
  my $cache  = shift;

  $target->{meta} = _load_meta( $target, $cache, 0 );
  return $target;
}

sub _config_prereq
{
  my $target = shift;
  my $cache  = shift;

  my $meta = $target->{meta};

  return $target
    if !defined $meta;

  my @config_deps = _phase_prereq( $target, $cache, 'configure' );

  $target->{configure_prereq} = [@config_deps];

  return @config_deps, $target;
}

sub _configure
{
  my $target = shift;
  my $cache  = shift;
  my $meta   = $target->{meta};

  state $mb_deps = { map { $_ => 1 }
      qw/version ExtUtils-ParseXS ExtUtils-Install ExtUtilsManifest/ };

  # meta may not be defined, so wrap it in an eval
  my $is_mb_dep = eval { exists $mb_deps->{ $meta->name } };
  my $maker;

  if ( -e 'Build.PL' && !$is_mb_dep )
  {
    run( $^X, 'Build.PL' );
    my $configured = -e -f 'Build';
    croak 'Unable to configure Buid.PL for ' . $target->{src_name}
      unless $configured;
    $maker = 'mb';
  }

  if ( !defined $maker && -e 'Makefile.PL' )
  {
    run( $^X, 'Makefile.PL' );
    my $configured = -e 'Makefile';
    croak 'Unable to configure Makefile.PL for ' . $target->{src_name}
      unless $configured;
    $maker = 'mm';
  }

  if ( !defined $maker )
  {
    croak 'Unable to configure '
      . $target->{src_name}
      . ' (Could not locate either Makefile.PL or Build.PL)';
  }

  $target->{maker} = $maker;
  return $target;
}

sub _mymeta
{
  my $target = shift;
  my $cache  = shift;

  my $new_meta = _load_meta( $target, $cache, 1 );
  $target->{meta} = $new_meta
    if defined $new_meta;

  $target->{name} = $target->{meta}->name;
  $target->{name} =~ s[-][::]xmsg;

  return $target;
}

sub _prereq
{
  my $target = shift;
  my $cache  = shift;

  my $meta = $target->{meta};

  my @deps = map { _phase_prereq( $target, $cache, $_ ) } qw/runtime build/;

  $target->{prereq} = [@deps];

  return @deps, $target;
}

sub _test_prereq
{
  my $target = shift;
  my $cache  = shift;

  my $meta = $target->{meta};
  my $opts = $cache->{opts};

  my $skip_tests = $opts->{'skip-tests'};
  if ( !$skip_tests )
  {
    my $skips = $opts->{'skip-tests-for'};
    $skip_tests = exists $skips->{ $target->{src_name} };

    if ( !$skip_tests && defined $target->{modules} )
    {
      foreach my $module ( %{ $target->{modules} } )
      {
        if ( $skips->{$module} )
        {
          $skip_tests = 1;
          last;
        }
      }
    }

    if ( !$skip_tests && $opts->{'smart-tests'} )
    {
      $skip_tests = _target_prereqs_were_installed( $target, $cache );
    }
  }

  $target->{skip_tests} = $skip_tests;

  my @deps;

  if ( !$skip_tests )
  {
    @deps = map { _phase_prereq( $target, $cache, $_ ) } qw/test/;
    push @{ $target->{prereq} }, @deps;
  }

  return @deps, $target;
}

sub _prereq_verify
{
  my $target = shift;
  my $cache  = shift;

  my @deps = _target_prereqs( $target, $cache );
  my @incomplete_deps = grep { $_->{state} ne $COMPLETE } @deps;

  if ( @incomplete_deps > 0 )
  {
    my $line = 'Unmet dependencies for: ' . $target->{src_name};
    error $target->{key}, $line;
    logmsg "Missing requirements: "
      . join( ", ", map { $_->{src_name} } @incomplete_deps );
    croak 'Error with prerequisites';
  }

  return $target;
}

sub _build
{
  my $target = shift;
  my $cache  = shift;

  local $ENV{PERL_MM_USE_DEFAULT}    = 0;
  local $ENV{NONINTERACTIVE_TESTING} = 0;
  state $make = $Config{make};

  my $opts = $cache->{opts};

  if ( $target->{maker} eq 'mb' )
  {
    run( $^X, './Build' );
    return $target;
  }

  if ( $target->{maker} eq 'mm' )
  {
    run($make);
    return $target;
  }

  croak 'Unable to determine how to install ' . $target->{meta}->name;
}

sub _test
{
  my $target = shift;
  my $cache  = shift;

  local $ENV{PERL_MM_USE_DEFAULT}    = 0;
  local $ENV{NONINTERACTIVE_TESTING} = 0;
  state $make = $Config{make};

  my $opts = $cache->{opts};

  if ( $target->{skip_tests} )
  {
    return $target;
  }

  if ( $target->{maker} eq 'mb' )
  {
    run( $^X, './Build', 'test' );
    return $target;
  }

  if ( $target->{maker} eq 'mm' )
  {
    run( $make, 'test' );
    return $target;
  }

  croak 'Unable to determine how to install ' . $target->{meta}->name;
}

sub _install
{
  my $target = shift;
  my $cache  = shift;

  local $ENV{PERL_MM_USE_DEFAULT}    = 0;
  local $ENV{NONINTERACTIVE_TESTING} = 0;
  state $make = $Config{make};

  my $opts = $cache->{opts};

  if ( $target->{maker} eq 'mb' )
  {
    run( $^X, './Build', 'install' );
    return $target;
  }

  if ( $target->{maker} eq 'mm' )
  {
    run( $make, 'install' );
    return $target;
  }

  croak 'Unable to determine how to install ' . $target->{meta}->name;
}

sub _write_meta
{
  my $target = shift;
  my $cache  = shift;

  state $arch_dir = "$Config{archname}/.meta/";

  if ( $target->{is_cpan} )
  {
    my $dir = "$dest_lib/$arch_dir/" . $target->{distvname};
    File::Path::mkpath( $dir, 0, 0777 );
    $target->{meta}->save("$dir/MYMETA.json");

    my $install = {
      name     => $target->{name},
      target   => $target->{src_name},
      version  => $target->{meta}->version,
      dist     => $target->{distvname},
      pathname => $target->{pathname},
      provides => $target->{meta}->provides,
    };

    open my $fh, ">", "$dir/install.json";
    print $fh JSON::PP::encode_json($install);
  }
  return;
}

my $full_pause_re = qr[
  (?: authors/id/ )
  (   \w / \w\w )
  /
  ( \w{2,} )
  /
  ( [^/]+ )
]xms;
my $pause_re = qr[
  ^

  (?: authors/id/ )?
  (?: \w / \w\w /)?

  ( \w{2,} )
  /
  ( .+ )

  $
]xms;

sub _escape
{
  my $str = shift;
  $str =~ s/ ([^A-Za-z0-9\-\._~]) / sprintf("%%%02X", ord($1)) /xmsge;
  return $str;
}

my $ident_re = qr/^ \p{ID_Start} (?: :: | \p{ID_Continue} )* $/xms;

sub _src_normalize
{
  my $target = shift;

  if ( ref $target eq '' )
  {
    if ( $target =~ m{^ ([^/]+) @ (.*) $}xms )
    {
      $target = [ $1, "==$2" ];
    }
    else
    {
      $target = [ split /[~]/xms, $target, 2 ];
    }
  }

  if ( ref $target eq 'ARRAY' )
  {
    $target = {
      src_name   => $target->[0],
      constraint => $target->[1],
    };
  }

  return {
    src_name   => $target->{src_name},
    constraint => $target->{constraint},
  };
}

sub _find_target
{
  my $target = shift;
  my $cache  = shift;

  my $src      = _src_normalize($target);
  my $src_name = $src->{src_name};

  return $cache->{targets}->{$src_name};
}

sub _alias_target
{
  my $target = shift;
  my $alias  = shift;
  my $cache  = shift;

  my $target = _find_target( $target, $cache );

  if ( $alias =~ $ident_re )
  {
    $target->{modules}->{$alias} = {
      inital_version => _get_mod_ver($alias),
    };
  }

  $cache->{targets}->{$alias} = $target;
  return;
}

sub _targets_from_cpanfile
{
  my $cpanfile = shift;
  my $cache    = shift;
  my $update   = shift;

  my $iname
    = $cpanfile =~ m{^(.[/\\])?cpanfile$}
    ? 'cpanfile'
    : "cpanfile $cpanfile";
  info "Reading $iname";

  my $prereq = parse_cpanfile($cpanfile);
  my @phases = qw/configure build test runtime/;

  my @acc = map {%$_} map { values %{ $prereq->{$_} } } @phases;
  my @reqs;
  while (@acc)
  {
    my $req    = [ splice( @acc, 0, 2 ) ];
    my $target = _create_target( $req, $cache );
    $target->{update} = $update // 1;
    push @reqs, $target;
  }

  return @reqs;
}

sub _create_inital_target
{
  my $src_name = shift;
  my $cache    = shift;
  my $update   = shift;

  # Check to see if the source is a cpanfile
  if ( ref $src_name eq '' || ref $src_name eq 'GLOB' )
  {
    if ( -d $src_name )
    {
      $src_name = File::Spec->catfile( $src_name, 'cpanfile' );
    }

    if ( -e -f $src_name )
    {
      # If the filename includes the work cpanfile or looks like a text file,
      # assume it's a cpanfile because a module archive must be binary
      if ( $src_name =~ m/cpanfile/ || -T $src_name )
      {
        return _targets_from_cpanfile( $src_name, $cache, $update );
      }
    }
  }

  my $target = _create_target( $src_name, $cache );
  $target->{update} = $update // 1;

  return $target;
}

sub _create_target
{
  my $target = shift;
  my $cache  = shift;

  my $src = _src_normalize($target);
  my $cached_target = _find_target( $target, $cache );

  if ( !defined $cached_target )
  {
    my $src_name = $src->{src_name};

    $cached_target = { %$src, state => 0 };
    $cache->{targets}->{$src_name} = $cached_target;
    $cached_target->{key} = $src_name;
  }

  if ( $cached_target->{state} eq $COMPLETE
    && $src->{constraint} ne $cached_target->{constraint} )
  {
    $cached_target->{constraint} = $src->{constraint};
    $cached_target->{state}      = 0;
    delete $cached_target->{version};
  }

  for my $altkey (qw/distvname name module/)
  {
    my $altname = $cached_target->{$altkey};
    if ( defined $altname )
    {
      if ( !exists $cache->{targets}->{$altname} )
      {
        _alias_target( $cached_target, $altname, $cache );
      }
    }
  }

  if ( $src->{src_name} =~ $ident_re )
  {
    $cached_target->{module} = $src->{src_name};
  }

  return $cached_target;
}

sub _target_prereqs
{
  my $target = shift;
  my $cache  = shift;

  return
    map { _find_target $_, $cache }
    ( @{ $target->{prereq} }, @{ $target->{configure_prereq} } );
}

sub _target_prereqs_were_installed
{
  my $target = shift;
  my $cache  = shift;

  foreach my $prereq ( _target_prereqs( $target, $cache ) )
  {
    _target_prereqs_were_installed( $prereq, $cache );

    if ( !$prereq->{prereqs_was_installed} || !$prereq->{was_installed} )
    {
      return $target->{prereqs_was_installed} = 0;
    }
  }

  return $target->{prereqs_was_installed} = 1;
}

sub _search_metacpan
{
  my $src        = shift;
  my $constraint = shift;

  state %seen;

  return $seen{$src}->{$constraint}
    if exists $seen{$src}->{$constraint};

  # TODO mirrors
  my $dnld = 'https://fastapi.metacpan.org/download_url/' . _escape($src);
  if ( defined $constraint )
  {
    $dnld .= '?version=' . _escape($constraint);
  }

  my $json_info = '';
  fetch_file( $dnld => \$json_info );

  my $result = JSON::PP::decode_json($json_info);
  $seen{$src}->{$constraint} = $result;

  return $result;
}

sub _get_targz
{
  my $target = shift;

  my $src = $target->{src_name};

  if ( -e -f $src )
  {
    return $src;
  }

  my $url;

  # git
  if ( $src =~ git_re )
  {
    my $min_git_ver = min_git_ver;
    croak "System has git version < $min_git_ver, cannot retrieve git URL"
      unless has_updated_git;

    croak "System does not have git, cannot retrieve git URL"
      unless has_git;

    my ( $git_url, $commit ) = $src =~ git_extract_re;
    my ($descr) = $git_url =~ m{ ([^/]*) $}xms;

    my $dir  = humane_tmpdir($descr);
    my $fh   = humane_tmpfile($descr);
    my $file = $fh->filename;

    run( 'git', 'clone', '--bare', $git_url, $dir );
    run(
      $fh, 'git', 'archive', '--format=tar.gz', "--remote=$dir",
      $commit || 'master'
    );
    close $fh;
    return $fh;
  }

  # URL
  if ( $src =~ url_re )
  {
    $url = $src;
  }

  # PAUSE
  if ( $src =~ $pause_re )
  {
    my $author  = $1;
    my $package = $2;
    $url = join(
      '/',
      'https://cpan.metacpan.org/authors/id',
      substr( $author, 0, 1 ),
      substr( $author, 0, 2 ),
      $author,
      $package,
    );

    $target->{is_cpan} = 1;
  }

  # Module Name
  if ( !defined $url )
  {
    my $json_data = _search_metacpan( $src, $target->{constraint} );

    $url = $json_data->{download_url};

    $target->{is_cpan} = 1;
    $target->{version} = version->parse( $json_data->{version} );
  }

  if ( defined $url )
  {
    # if it's pause like, parse out the distibution's version name
    if ( $url =~ $full_pause_re )
    {
      my $package = $3;
      $target->{pathname} = "$1/$2/$3";
      $package =~ s/ (.*) [.] ( tar[.](gz|z|bz2) | zip | tgz) $/$1/xmsi;
      $target->{distvname} = $package;
    }

    return fetch_file($url);
  }

  croak "Cannot find $src\n";
}

sub _get_core_ver
{
  my $module = shift;
  my $ver    = $Module::CoreList::version{$]}{$module};
  undef $ver
    if defined $Module::CoreList::deprecated{$]}{$module};
  return $ver;
}

sub _get_mod_ver
{
  my $module = shift;
  return $]
    if $module eq 'perl';
  local $@;
  my $ver = eval {
    my $file = _installed_file_for_module($module);
    MM->parse_version($file);
  };

  $ver = _get_core_ver($module)
    if !defined $ver;

  return $ver;
}

sub _load_meta
{
  my $target = shift;
  my $cache  = shift;
  my $my     = shift;

  my $prefix = $my ? 'MYMETA' : 'META';

  my $meta;

  foreach my $file ( "$prefix.json", "$prefix.yml" )
  {
    $meta = eval { CPAN::Meta->load_file($file) };
    last
      if defined $meta;
  }

  return $meta;
}

sub _phase_prereq
{
  my $target = shift;
  my $cache  = shift;
  my $phase  = shift;

  my $prereqs = $target->{meta}->effective_prereqs;
  my @result;

  my $requirements = $prereqs->requirements_for( $phase, "requires" );
  my $reqs = $requirements->as_string_hash;
  for my $module ( sort keys %$reqs )
  {
    my $is_core;
    my $version = _get_core_ver($module);

    if ( defined $version )
    {
      $is_core = $requirements->accepts_module( $module, $version );
    }

    push @result, [ $module, $reqs->{$module} ]
      if $module ne 'perl' && !$is_core;
  }

  return @result;
}

sub _installed_file_for_module
{
  my $prereq = shift;
  my $file   = "$prereq.pm";
  $file =~ s{::}{/}g;

  state $archname = $Config{archname};
  state $perlver  = $Config{version};

  for my $dir (
    "$dest_lib/$archname",
    "$dest_lib",
    )
  {
    my $tmp = File::Spec->catfile( $dir, $file );
    return $tmp
      if -r $tmp;
  }
}

sub _should_install
{
  my $target = shift;

  return 1
    unless defined $target->{module};

  my $module = $target->{module};
  my $ver    = _get_mod_ver($module);

  return 1
    if !defined $ver;

  $target->{installed_version} = $ver;

  my $msg = 'Up to date';

  $msg = 'Installed'
    if $target->{was_installed};

  if ( !$target->{update} )
  {
    my $constraint = $target->{constraint};
    my $prereq     = CPAN::Meta::Prereqs->new(
      { runtime => { requires => { $module => $constraint // 0 } } } );
    my $req = $prereq->requirements_for( 'runtime', 'requires' );

    if ( $req->accepts_module( $module, $ver ) )
    {
      success(
        $target->{key},
        _target_line( $target, $msg )
      );
      _complete($target);
      return;
    }
  }

  if ( defined $target->{version} && $target->{version} eq $ver )
  {
    success(
      $target->{key},
      _target_line( $target, $msg )
    );
    _complete($target);
    return;
  }

  return 1;
}

sub _source_translate
{
  my $src_name = shift;
  my $opts     = shift;
  my $sources  = $opts->{source};

  my $new_src;

  if ( ref $sources eq 'HASH' )
  {
    $new_src = $sources->{$src_name};
  }

  if ( ref $sources eq 'CODE' )
  {
    $new_src = $sources->($src_name);
  }

  if ( $opts->{'only-sources'} && !defined $new_src )
  {
    if ( _get_core_ver($src_name) )
    {
      return $src_name;
    }

    croak "Unable to locate $src_name from the sources list\n";
  }

  return defined $new_src ? $new_src : $src_name;
}

sub _complete
{
  my $target = shift;
  $target->{state} = $COMPLETE;

  # If we are marking complete because the installed version is the Core
  # version, mark that it "was_installed"
  if ( exists $target->{installed_version} && !$target->{was_installed} )
  {
    my $module = $target->{module};
    my $ver    = $target->{installed_version};

    $target->{was_installed} = 1
      if $ver eq _get_core_ver($module);
  }

  if ( exists $target->{inital_version}
    && !defined $target->{inital_version} )
  {
    # If the module was initally not installed but now is, we probbaly
    # installed it by another package name, so mark it as was_installed
    $target->{was_installed} = 1
      if defined _get_mod_ver( $target->{module} );
  }

  return;
}

sub _failed
{
  my $target = shift;
  $target->{state} = $FAILED;
  return;
}

sub _name_target
{
  my $target = shift;
  return $target->{name} || $target->{module} || $target->{src_name};
}

sub _target_line
{
  my $target = shift;
  my $status = shift;

  my $line = sprintf( '%-13s %s', $status, _name_target($target) );

  return $line;
}

1;
# line 1 "App/MechaCPAN/Perl.pm"
package App::MechaCPAN::Perl;

use v5.14;
use autodie;
use Config;
use FindBin;
use File::Spec;
use App::MechaCPAN qw/:go/;

our @args = (
  'threads!',
  'jobs=i',
  'skip-tests!',
  'skip-local!',
  'skip-lib!',
  'smart-tests!',
  'devel!',
  'shared-lib!',
  'build-reusable!',
  'source-only',
);

my $perl5_ver_re = qr/v? 5 [.] (\d{1,2}) (?: [.] (\d{1,2}) )?/xms;
my $perl5_re     = qr/^ $perl5_ver_re $/xms;

our $JOBS = 2;    # The number of jobs to run with make

sub go
{
  my $class = shift;
  my $opts  = shift;
  my $src   = shift;
  my @argv  = shift;

  if ( $^O eq 'MSWin32' )
  {
    info 'Cannot build perl on Win32';
    return 0;
  }

  my $orig_dir = &get_project_dir;
  my $dest_dir = &dest_dir;
  my @dest_dir = File::Spec->splitdir("$dest_dir");
  my $dest_len = $#dest_dir;
  my $perl_dir = "$dest_dir/perl";
  my $pv_ver;    # Version in .perl-version file

  # Attempt to find the perl version if none was given
  if ( -f '.perl-version' )
  {
    open my $pvFH, '<', '.perl-version';
    $pv_ver = do { local $/; <$pvFH> };
    $pv_ver =~ s/\s+//xmsg;
    if ( $pv_ver !~ $perl5_re )
    {
      info "$pv_ver in .perl-version doesn't look like a perl5 version";
      undef $pv_ver;
    }
  }

  my ( $src_tz, $version ) = _get_targz( $src // $pv_ver, $opts );
  my $bin_tz;
  if ( ref $src_tz eq 'ARRAY' )
  {
    ( $bin_tz, $src_tz ) = @$src_tz;
  }

  # If _get_targz couldn't find a version, guess based on the file
  if ( !$version && $src_tz =~ m($perl5_ver_re [^/]* $)xms )
  {
    my $major = $1;
    my $minor = $2;

    $version = "5.$major.$minor";
    info("Looks like $src_tz is perl $version, assuming that's true");
  }

  local $JOBS = $opts->{jobs} // $JOBS;

  if ( $opts->{'build-reusable'} )
  {
    return build_reusable( $version, $perl_dir, $src_tz, $opts );
  }

  if ( -e -x "$perl_dir/bin/perl" )
  {
    unless ( $opts->{is_restarted_process} )
    {
      # If it exists, we're probably running it by now.
      if ( $version && $^V ne "v$version" )
      {
        info(
          $version,
          "perl has already been installed ($^V, not $version)"
        );
      }
      else
      {
        success( $version, "perl has already been installed" );
      }
    }
    return 0;
  }

  my $verstr = "perl $version";
  info $verstr, "Fetching $verstr";

  if ( defined $bin_tz && !$opts->{'source-only'} )
  {
    my $src_dir = inflate_archive($bin_tz);

    my @src_dirs = File::Spec->splitdir("$src_dir");
    chdir $src_dir;

    if ( -e -x File::Spec->catdir( @src_dirs, qw/bin perl/ ) )
    {
      local $@;
      my $success
        = eval { _install_binary( File::Spec->catdir(@src_dirs), $version ) };
      my $error = $@;
      if ($error)
      {
        logmsg "Binary in $bin_tz does not appear to be usable: $error";
      }
      return 0
        if $success == 0;
    }
    logmsg "$bin_tz did not have a perl binary";
  }

  my $src_dir = inflate_archive($src_tz);

  my @src_dirs = File::Spec->splitdir("$src_dir");
  chdir $src_dir;

  if ( -e -x File::Spec->catdir( @src_dirs, qw/bin perl/ ) )
  {
    die "Binary archive provided, but source-only was requested"
      if $opts->{'source-only'};
    return _install_binary( File::Spec->catdir(@src_dirs), $version );
  }

  if ( !-e 'Configure' )
  {
    my @files = glob('*');
    if ( @files != 1 )
    {
      die qq{Could not find perl to configure.}
        . qq{Inflated to "$src_dir" extracted from $src_tz};
    }
    chdir $files[0];
  }

  my $local_dir = File::Spec->catdir( @dest_dir, qw/lib perl5/ );
  my $lib_dir
    = File::Spec->catdir( @dest_dir[ 0 .. $dest_len - 1 ], qw/lib/ );

  my @otherlib = (
    !$opts->{'skip-local'}              ? $local_dir : (),
    !$opts->{'skip-lib'} && -d $lib_dir ? $lib_dir   : (),
  );

  my @config = (
    _build_configure( $perl_dir, $opts ),
    q[-Accflags=-DAPPLLIB_EXP=\"] . join( ":", @otherlib ) . q[\"],
    qq[-A'eval:scriptdir=$perl_dir/bin'],
  );

  local %ENV = %ENV;
  delete @ENV{qw(PERL5LIB PERL5OPT)};

  # Make sure no tomfoolery is happening with perl, like plenv shims
  $ENV{PATH} = $Config{binexp} . ":$ENV{PATH}";

  eval {
    require Devel::PatchPerl;
    info $verstr, "Patching $verstr";
    Devel::PatchPerl->patch_source();
  };

  info $verstr, "Configuring $verstr";
  _run_configure(@config);

  info $verstr, "Building $verstr";
  _run_make();

  my $skip_tests = $opts->{'skip-tests'};

  if ( !$skip_tests && $opts->{'smart-tests'} )
  {
    $skip_tests = $pv_ver eq $version;
  }

  if ( !$skip_tests )
  {
    info $verstr, "Testing $verstr";
    _run_make('test_harness');
  }

  info $verstr, "Installing $verstr";
  _run_make('install');

  success "Installed $verstr";

  chdir $orig_dir;

  &restart_script();

  return 0;
}

# These are split out mostly so we can control testing

sub _build_configure
{
  my $perl_dir = shift;
  my $opts     = shift;

  my @config = (
    q[-des],
    qq[-Dprefix=$perl_dir],
  );

  if ( $opts->{threads} )
  {
    push @config, '-Dusethreads';
  }

  if ( $opts->{'shared-lib'} )
  {
    push @config, '-Duseshrplib';
  }

  if ( $opts->{devel} )
  {
    push @config, '-Dusedevel';
  }

  return @config;
}

sub _run_configure
{
  my @config = @_;
  run qw[sh Configure], @config;
}

sub _run_make
{
  my @cmd = @_;
  state $make = $Config{make};
  state $can_jobs;

  if ( !defined $can_jobs )
  {
    $can_jobs = '';
    my $make_help
      = eval { run( $make, '-h' ) } // eval { run( $make, '--help' ) } // '';

    if ( $make_help =~ m/^\s*-j\s+/xms )
    {
      $can_jobs = '-j';
    }
    elsif ( $make_help =~ m/^\s*--jobs\s+/xms )
    {
      $can_jobs = '--jobs';
    }
  }

  my @jobs_cmd;
  if ( $JOBS > 1 && $can_jobs )
  {
    @jobs_cmd = ( $can_jobs, $JOBS );
  }

  # Give perl more time to be silent during the make process than normal
  local $App::MechaCPAN::TIMEOUT = $App::MechaCPAN::TIMEOUT * 10;

  run $make, @jobs_cmd, @cmd;
}

sub slugline
{
  my $perl        = shift || File::Spec->canonpath($^X);
  my $version     = shift || '';
  my $use_threads = shift;

  my $script = <<'EOD';
  use strict;
  use Config;
  my $version    = $ARGV[0] || $^V;
  my $usethreads = defined $ARGV[1] ? $ARGV[1] : 0;
  my $libcname   = 'unknown';
  my $libcver    = 'ukn';
  my $archname   = ( split '-', $Config{archname} )[0];
  my $osname     = $Config{osname};
  my $threads    = $usethreads ? 'threads-' : '';

  if ( $Config{gnulibc_version} )
  {
    $libcname = 'glibc';
    $libcver  = $Config{gnulibc_version};
  }
  else
  {
    my $libc_re         = qr/libc (\W|$)/xms;
    my ($libc_basename) = grep {m/$libc_re/} split( / /, $Config{libsfiles} );
    my ($libc_path) = grep {m/$libc_basename/} split / /, $Config{libsfound};
    my $libc_so     = $libc_path;
    $libc_so =~ s/[.]a([\d.]*)$/.so$1/;
    if ( -x $libc_so )
    {
      my $help = `$libc_so 2>&1`;
      if ( $help =~ m/^ musl \s libc .* Version \s* ([0-9.]+)/xms )
      {
        $libcname = 'musl';
        $libcver  = $1;
      }
    }
  }
  print "perl-$version-$archname-$osname-$threads$libcname-$libcver";
EOD

  my $script_file = humane_tmpfile;
  $script_file->print($script);
  $script_file->close;

  my $slugline = run(
    $perl,
    "$script_file",
    $version,
    ( defined $use_threads ? ($use_threads) : () )
  );
  chomp $slugline;

  return $slugline;
}

sub _check_perl_binary
{
  my $perl_bin = shift;

  # We include POSIX, that's a good litmus that libc is not completely broken
  # and we use crypt to test that the crypt lib is loadable. This is simply
  # a bare minimum check and it may change in the future
  no warnings 'qw';
  my @check = qw/-MPOSIX -e crypt('00','test')/;

  run "$perl_bin", @check;
  return 1;
}

sub build_reusable
{
  my $version  = shift;
  my $perl_dir = shift;
  my $src_tz   = shift;
  my $opts     = shift;

  # Determine what to compress it with
  my $compress
    = eval  { run(qw/xz --version/);    'xz' }
    // eval { run(qw/bzip2 --version/); 'bzip2' }
    // eval { run(qw/gzip --version/);  'gzip' }
    // die 'Cannot find anything to compress with';

  # Make sure we can call tar before we get too far
  die 'Cannot find tar to create an archive'
    if !( eval { run(qw/tar --version/) } );

  $perl_dir = humane_tmpdir("perl-$version");
  my $verstr = "perl $version";
  info $verstr, "Fetching $verstr";

  my $src_dir = inflate_archive($src_tz);

  my @src_dirs = File::Spec->splitdir("$src_dir");
  chdir $src_dir;

  if ( !-e 'Configure' )
  {
    my @files = glob('*');
    if ( @files != 1 )
    {
      die qq{Could not find perl to configure.}
        . qq{Inflated to "$src_dir" extracted from $src_tz};
    }
    chdir $files[0];
  }

  my $local_dir = File::Spec->catdir(qw/... .. .. lib perl5/);
  my $lib_dir   = File::Spec->catdir(qw/... .. .. .. lib/);

  my @otherlib = (
    !$opts->{'skip-local'} ? $local_dir : (),
    !$opts->{'skip-lib'}   ? $lib_dir   : (),
  );

  my @config = (
    _build_configure( $perl_dir, $opts ),
    q[-Accflags=-DAPPLLIB_EXP=\"] . join( ":", @otherlib ) . q[\"],
    q{-Dstartperl='#!/usr/bin/env\ perl'},
    q{-Dperlpath='/usr/bin/env\ perl'},
    qq{-Dinstallprefix=/v$version},
    qq{-Dprefix=/v$version},
    q{-Dman1dir=.../../man/man1},
    q{-Dman3dir=.../../man/man3},
    q{-Duserelocatableinc},
  );

  if ( $opts->{threads} )
  {
    push @config, '-Dusethreads';
  }

  local %ENV = %ENV;
  delete @ENV{qw(PERL5LIB PERL5OPT)};
  $ENV{DESTDIR} = $perl_dir;

  # Make sure no tomfoolery is happening with perl, like plenv shims
  $ENV{PATH} = $Config{binexp} . ":$ENV{PATH}";

  eval {
    require Devel::PatchPerl;
    info $verstr, "Patching $verstr";
    Devel::PatchPerl->patch_source();
  };

  info $verstr, "Configuring $verstr";
  _run_configure(@config);

  info $verstr, "Building $verstr";
  _run_make();

  my $skip_tests = $opts->{'skip-tests'} // $opts->{'smart-tests'};

  if ( !$skip_tests )
  {
    info $verstr, "Testing $verstr";
    _run_make('test_harness');
  }

  info $verstr, "Installing $verstr";
  _run_make('install');

  # Verify that the relocatable bits worked
  local $@;
  eval { _check_perl_binary("$perl_dir/v$version/bin/perl") };
  my $error = $@;
  if ($error)
  {
    die "The built relocatable binary appears broken: $error\n";
  }

  my $slugline = slugline("$perl_dir/v$version/bin/perl", undef, $opts->{threads});
  my $orig_dir = &get_project_dir;
  my $output   = "$slugline.tar.$compress";
  chdir $perl_dir;
  run("tar cf - v$version/ | $compress > $orig_dir/$output");

  success $verstr, "Created $verstr: $output";

  return 0;
}

sub _install_binary
{
  my $src_dir  = shift;
  my $version  = shift;
  my @src_dirs = File::Spec->splitdir("$src_dir");
  my $dest_dir = &dest_dir;
  my $perl_dir = File::Spec->catdir( $dest_dir, 'perl' );

  info $version, "Installing $version";

  use File::Copy qw/copy move/;
  use File::Path qw/make_path/;
  use Fatal qw/copy move/;

  chdir $dest_dir;
  my $output = eval { run "$src_dir/bin/perl", '-e', 'print $^V' };
  chomp $output;

  if ( $output ne "v$version" )
  {
    die qq{Binary versions mismatch expectations: }
      . qq{"$output" (found) ne "$version" (expected)};
  }

  # Attempt to run something more rigorous
  local $@;
  eval { _check_perl_binary("$src_dir/bin/perl") };
  my $error = $@;
  if ($error)
  {
    die "Binary does not appear to be usable: $error";
  }

  make_path($perl_dir);
  move( $src_dir, $perl_dir );

  success "Installed binary $version";

  return 0;
}

our $source_mirror = 'https://www.cpan.org/src/5.0';
our $binary_mirror = 'https://dnld.mechacpan.us/dist';

sub _dnld_url
{
  my $version = shift;
  my $minor   = shift;

  return "$source_mirror/perl-5.$version.$minor.tar.gz";
}

sub _bin_url
{
  my $version = shift;
  my $minor   = shift;
  my $opts    = shift;

  my $fullver  = "v5.$version.$minor";
  my $slugline = slugline( undef, $fullver, $opts->{threads} );

  return "$binary_mirror/$slugline.tar.xz";
}

sub _get_targz
{
  my $src  = shift;
  my $opts = shift;

  # If there's no src, find the newest version.
  if ( !defined $src )
  {
    # Do a terrible job of guessing what the current version is
    use Time::localtime;
    my $year = localtime->year() + 1900;

    # 5.12 was released in 2010, and approximatly every May, a new even
    # version was released
    my $major = ( $year - 2010 ) * 2 + ( localtime->mon < 4 ? 10 : 12 );

    # Verify our guess
    {
      my $dnld     = _dnld_url( $major, 0 ) . ".md5.txt";
      my $contents = '';
      my $where    = eval { fetch_file( $dnld => \$contents ) };

      if ( !defined $where && $major > 12 )
      {
        $major -= 2;
        redo;
      }
    }
    $src = "5.$major";
  }

  # file
  if ( -e $src )
  {
    return ( rel_start_to_abs($src), '' );
  }

  my $url;

  # URL
  if ( $src =~ url_re )
  {
    return ( $src, '' );
  }

  # CPAN
  if ( $src =~ $perl5_re )
  {
    my $version = $1;
    my $minor   = $2;

    # They probably want the latest if minor wasn't given
    if ( !defined $minor )
    {
      # 11 is the highest minor version seen as of this writing
      my @possible = ( 0 .. 15 );

      while ( @possible > 1 )
      {
        my $i = int( @possible / 2 );
        $minor = $possible[$i];
        my $dnld     = _dnld_url( $version, $minor ) . ".md5.txt";
        my $contents = '';
        my $where    = eval { fetch_file( $dnld => \$contents ) };

        if ( defined $where )
        {
          # The version exists, which means it's higher still
          @possible = @possible[ $i .. $#possible ];
        }
        else
        {
          # The version doesn't exit. That means higher versions don't either
          @possible = @possible[ 0 .. $i - 1 ];
        }
      }
      $minor = $possible[0];
    }

    return (
      [
        _bin_url( $version, $minor ),
        _dnld_url( $version, $minor, $opts ),
      ],
      "5.$version.$minor"
    );
  }

  die "Cannot find $src\n";
}

1;
package main;
#!/usr/bin/env perl

use App::MechaCPAN;

exit App::MechaCPAN::main(@ARGV);