view release on metacpan or  search on metacpan

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

      $self->setup_verify if $self->{verify};
  
      if (my $action = $self->{action}) {
          $self->$action() and return 1;
      }
  
      return $self->show_help(1)
          unless @{$self->{argv}} or $self->{load_from_stdin};
  
      $self->configure_mirrors;
  
      my $cwd = Cwd::cwd;
  
      my @fail;
      for my $module (@{$self->{argv}}) {
          if ($module =~ s/\.pm$//i) {
              my ($volume, $dirs, $file) = File::Spec->splitpath($module);
              $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
          }
          ($module, my $version) = $self->parse_module_args($module);
  
          $self->chdir($cwd);
          if ($self->{cmd} eq 'uninstall') {
              $self->uninstall_module($module)
                or push @fail, $module;
          } else {
              $self->install_module($module, 0, $version)
                  or push @fail, $module;
          }
      }
  
      if ($self->{base} && $self->{auto_cleanup}) {
          $self->cleanup_workdirs;
      }
  
      if ($self->{installed_dists}) {
          my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
          $self->diag("$self->{installed_dists} $dists installed\n", 1);
      }
  
      if ($self->{scandeps}) {
          $self->dump_scandeps();
      }
      # Workaround for older File::Temp's
      # where creating a tempdir with an implicit $PWD
      # causes tempdir non-cleanup if $PWD changes
      # as paths are stored internally without being resolved
      # absolutely.
      # https://rt.cpan.org/Public/Bug/Display.html?id=44924
      $self->chdir($cwd);
  
      return !@fail;
  }
  
  sub setup_home {
      my $self = shift;
  
      $self->{home} = $self->env('HOME') if $self->env('HOME');
  
      unless (_writable($self->{home})) {
          die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
      }
  
      $self->{base} = "$self->{home}/work/" . time . ".$$";
      File::Path::mkpath([ $self->{base} ], 0, 0777);
  
      # native path because we use shell redirect
      $self->{log} = File::Spec->catfile($self->{base}, "build.log");
      my $final_log = "$self->{home}/build.log";
  
      { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
  
      if (CAN_SYMLINK) {
          my $build_link = "$self->{home}/latest-build";
          unlink $build_link;
          symlink $self->{base}, $build_link;
  
          unlink $final_log;
          symlink $self->{log}, $final_log;
      } else {
          my $log = $self->{log}; my $home = $self->{home};
          $self->{at_exit} = sub {
              my $self = shift;
              my $temp_log = "$home/build.log." . time . ".$$";
              File::Copy::copy($log, $temp_log)
                  && unlink($final_log);
              rename($temp_log, $final_log);
          }
      }
  
      $self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" .
                  "Work directory is $self->{base}\n");
  }
  
  sub package_index_for {
      my ($self, $mirror) = @_;
      return $self->source_for($mirror) . "/02packages.details.txt";
  }
  
  sub generate_mirror_index {
      my ($self, $mirror) = @_;
      my $file = $self->package_index_for($mirror);
      my $gz_file = $file . '.gz';
      my $index_mtime = (stat $gz_file)[9];
  
      unless (-e $file && (stat $file)[9] >= $index_mtime) {
          $self->chat("Uncompressing index file...\n");
          if (eval {require Compress::Zlib}) {
              my $gz = Compress::Zlib::gzopen($gz_file, "rb")
                  or do { $self->diag_fail("$Compress::Zlib::gzerrno opening compressed index"); return};
              open my $fh, '>', $file
                  or do { $self->diag_fail("$! opening uncompressed index for write"); return };
              my $buffer;
              while (my $status = $gz->gzread($buffer)) {
                  if ($status < 0) {
                      $self->diag_fail($gz->gzerror . " reading compressed index");
                      return;
                  }
                  print $fh $buffer;
              }
          } else {