view release on metacpan or  search on metacpan

lib/CPAN/Maker/Bootstrapper/Role/Installer.pm  view on Meta::CPAN

  return $SUCCESS;
}

########################################################################
sub check_return_code {
########################################################################
  my ( $self, $rc ) = @_;

  die "ERROR: could not execute make: $OS_ERROR\n"
    if $rc == -1;

  die sprintf "ERROR: make killed by signal %d\n", $rc & 127
    if $rc & 127;

  die sprintf "ERROR: make failed with exit code %d\n", $rc >> 8
    if $rc >> 8;

  return;
}

########################################################################
sub _create_dirs {
########################################################################
  my ($self) = @_;

  my $installdir = $self->get_installdir;

  my @dirs = ( $installdir, map {"$installdir/$_"} qw(t lib bin .includes) );

  make_path(@dirs);

  foreach (@dirs) {
    die "ERROR: could not create $_\n"
      if !-d $_;
  }

  return;
}

########################################################################
sub _install_files {
########################################################################
  my ($self) = @_;

  my $installdir = $self->get_installdir;

  my $dist_dir = $self->get_dist_dir;

  my @manifest = split /\n/xsm, slurp("$dist_dir/MANIFEST");

  foreach (@manifest) {
    die "ERROR: MANIFEST contains corrupted entry ($_)\n"
      if $_ !~ m{\A[[:alnum:]][[:alnum:]._-]*(?:/[[:alnum:]][[:alnum:]._-]*)*\z}xsm;

    die "ERROR: $_ is not found in the distribution. MANIFEST may be corrupted.\n"
      if !-e "$dist_dir/$_";

    if (/[.]mk$/xsm) {
      die "ERROR: could not copy $dist_dir/$_ to $installdir/.includes/$_\n"
        if !copy( "$dist_dir/$_", "$installdir/.includes/$_" );
      chmod 0444, "$installdir/.includes/$_";
    }
    else {
      die "ERROR: could not copy $dist_dir/$_ to $installdir/$_\n"
        if !copy( "$dist_dir/$_", "$installdir/$_" );
    }
  }

  # no need to check file existence, copy will fail above or rename will fail and be caught
  rename "$installdir/Makefile.txt", "$installdir/Makefile"
    or die "ERROR: error renaming $installdir/Makefile.txt to $installdir/Makefile: $OS_ERROR\n";

  chmod 0444, "$installdir/Makefile";
  chmod 0555, "$installdir/builder";

  rename "$installdir/gitignore", "$installdir/.gitignore"
    or die "ERROR: error renaming $installdir/gitignore to $installdir/.gitignore: $OS_ERROR\n";

  return;
}

########################################################################
sub _import_files {
########################################################################
  my ($self) = @_;

  my $installdir = $self->get_installdir;

  my $import_listing = $self->get_import_file_listing;

  return
    if !$import_listing;

  # directory structure is derived from the primary package name, not the
  # source path - the source may have arbitrary leading path components
  my ( $packages, $scripts, $tests ) = @{$import_listing}{qw(packages scripts tests)};

  if ( $scripts && @{$scripts} ) {
    # add built files in bin/ to .gitgnore
    my $gitignore = slurp("$installdir/.gitignore");
    $gitignore .= join "\n", map {"bin/$_"} @{$scripts};

    open my $fh, '>', "$installdir/.gitignore"
      or die "ERROR: could not replace .gitignore: $OS_ERROR\n";
    print {$fh} $gitignore;
    close $fh;

    # copy scripts to bin
    foreach my $s ( @{$scripts} ) {
      my $dest = sprintf '%s/bin/%s.in', $installdir, basename($s);
      $self->get_logger->debug( sprintf 'copying %s => %s', $s, $dest );

      die "ERROR: error copying $s to $dest\n"
        if !copy( $s, $dest );

      chmod 0644, $dest;  # remove -x
    }
  }

  # copy tests to t
  foreach my $t ( @{$tests} ) {
    my $dest = sprintf '%s/t/%s', $installdir, basename($t);
    $self->get_logger->debug( sprintf 'copying %s => %s', $t, $dest );

    die "ERROR: error copying $t to $dest\n"
      if !copy( $t, $dest );

    chmod 0644, $dest;  # make sure they are writable
  }

  # create sub directories and copy packages
  foreach my $p ( keys %{$packages} ) {

    my $primary = $self->_find_primary_package( $p, $packages->{$p} );

    if ( !$primary ) {
      warn "WARNING: could not determine primary package for $p...skipping.\n";
      next;
    }

    my $path = $primary;
    $path =~ s/::/\//xsmg;

    my $lib_path = sprintf '%s/lib/%s', $installdir, dirname($path);

    make_path($lib_path);
    die "ERROR: could not create $lib_path\n" if !-d $lib_path;

    my $dest = sprintf '%s/%s.in', $lib_path, basename($p);
    die "ERROR: could not copy $p to $dest\n"
      if !copy( $p, $dest );

    chmod 0644, $dest;  # make sure they are writable
  }

  return;
}

########################################################################
sub _create_resources_file {
########################################################################
  my ( $self, $module_name, $installdir ) = @_;

  my $project_name = $module_name;
  $project_name =~ s/::/-/xsmg;

  my $github_user = $self->get_github_user;
  warn "WARNING: no github_user found in config or passed. Using default (anonymouse). Edit resources.yml to fix.\n"
    if !defined $github_user;

  $github_user //= 'anonymouse';

  require Email::Valid;
  require YAML::Tiny;

  my $email = $self->get_email;
  die "ERROR: invalid email address\n"
    if $email && !Email::Valid->address($email);

  my $resources = {
    bugtracker => {
      web => sprintf( 'https://github.com/%s/%s/issues', $github_user, $project_name ),
      $self->get_email ? ( mailto => $self->get_email ) : (),
    },
    repository => {
      type => 'git',
      url  => sprintf( 'git@github.com:%s/%s.git', $github_user, $project_name ),
      web  => sprintf( 'https://github.com/%s/%s', $github_user, $project_name ),
    },
    homepage => sprintf( 'https://github.com/%s/%s', $github_user, $project_name ),
  };

  open my $fh, '>', "$installdir/resources.yml"
    or die "ERROR: could not open resources.yml for writing: $OS_ERROR\n";

  my $yml = YAML::Tiny::Dump( { resources => $resources } );
  $yml =~ s/^---\n//xsm;

  print {$fh} $yml;

  close $fh
    or warn "WARNING: could not close resources.yml: $OS_ERROR\n";

  return;
}

########################################################################
sub _import_file_listing {
########################################################################
  my ($self) = @_;

  my @import_paths = ref $self->get_import ? @{ $self->get_import } : ( $self->get_import );
  $self->get_logger->debug( 'import paths: ' . join "\n", @import_paths );