view release on metacpan or  search on metacpan

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

  }

  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;

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

  if ( $alias =~ $ident_re )
  {
    $target->{modules}->{$alias} = {

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

  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;