cpan/install.cgi

   1 #!/usr/local/bin/perl
   2 # install.cgi
   3 # Install a downloaded perl module
   4
   5 require './cpan-lib.pl';
   6 &ReadParse();
   7 @pfile = split(/\0/, $in{'pfile'});
   8
   9 if ($in{'need'}) {
  10         # Some pre-reqs are needed .. return to the download form
  11         @cpan = ( split(/\0/, $in{'needreq'}), split(/\0/, $in{'mod'}) );
  12         unlink(@pfile);         # will re-get
  13         &redirect("download.cgi?source=3&cpan=".&urlize(join(" ", @cpan)));
  14         }
  15
  16 foreach $pfile (@pfile) {
  17         -r $pfile || &error(&text('install_efile', "<tt>$pfile</tt>"));
  18         }
  19 &ui_print_unbuffered_header(undef, $text{'install_title'}, "");
  20
  21 # Set environment variables
  22 for($i=0; defined($in{"name_$i"}); $i++) {
  23         if ($in{"name_$i"} ne "") {
  24                 $ENV{$in{"name_$i"}} = $in{"value_$i"};
  25                 }
  26         }
  27
  28 # Go through all the modules
  29 @mods = split(/\0/, $in{'mod'});
  30 @dirs = split(/\0/, $in{'dir'});
  31 $perl_path = &get_perl_path();
  32 for($i=0; $i<@mods; $i++) {
  33         print &text('install_doing_'.$in{'act'}, "<tt>$mods[$i]</tt>"),"<p>\n";
  34
  35         # Untar the perl module
  36         $mod_dir = &transname($dirs[$i]);
  37         ($mod_par = $mod_dir) =~ s/\/[^\/]+$//;
  38         system("rm -rf $mod_dir >/dev/null 2>&1");
  39         &show_output($text{'install_untar'}, $mod_par,
  40                      "gunzip -c $pfile[$i] | tar xvf -");
  41
  42         if (-r "$mod_dir/Makefile.PL") {
  43                 # Run Makefile.PL and make
  44                 &show_output($text{'install_make'}, $mod_dir,
  45                              "$perl_path Makefile.PL $in{'args'} && make") ||
  46                         &build_error();
  47
  48                 # Run make test (if requested)
  49                 if ($in{'act'} == 1 || $in{'act'} == 3) {
  50                         &show_output($text{'install_test'}, $mod_dir,
  51                                      "make test") || &build_error();
  52                         }
  53
  54                 # Run make install (if requested)
  55                 if ($in{'act'} == 2 || $in{'act'} == 3) {
  56                         &show_output($text{'install_install'}, $mod_dir,
  57                                      "make install") || &build_error();
  58                         }
  59                 }
  60         else {
  61                 # Run Build.PL and Build
  62                 &show_output($text{'install_make'}, $mod_dir,
  63                              "$perl_path Build.PL $in{'args'} && ./Build") ||
  64                         &build_error();
  65
  66                 # Run Build test (if requested)
  67                 if ($in{'act'} == 1 || $in{'act'} == 3) {
  68                         &show_output($text{'install_test'}, $mod_dir,
  69                                      "./Build test") || &build_error();
  70                         }
  71
  72                 # Run Build install (if requested)
  73                 if ($in{'act'} == 2 || $in{'act'} == 3) {
  74                         &show_output($text{'install_install'}, $mod_dir,
  75                                      "./Build install") || &build_error();
  76                         }
  77                 }
  78
  79         # Clean up files
  80         print "<p>",&text('install_done_'.$in{'act'}, "<tt>$mods[$i]</tt>"),
  81               "<p>\n";
  82         system("rm -rf $mod_dir") if ($mod_dir && -d $mod_dir);
  83         }
  84 &clean_up(1);
  85
  86 # clean_up(success)
  87 sub clean_up
  88 {
  89 system("rm -rf $mod_dir") if ($mod_dir && -d $mod_dir);
  90 unlink(@pfile) if ($in{'need_unlink'} && (!$config{'save_partial'} || $_[0]));
  91 &ui_print_footer($in{'return'}, $in{'returndesc'} || $text{'index_return'});
  92 }
  93
  94 # show_output(desc, dir, command)
  95 sub show_output
  96 {
  97 local (%seen, $endless_loop);
  98 print &ui_table_start($_[0], undef, 2);
  99 local $msg = "<pre>".&text('install_exec', $_[2])."\n";
 100 $msg .= (" " x 100)."\n";
 101 open(CMD, "(cd $_[1] ; $_[2]) 2>&1 </dev/null |");
 102 while(<CMD>) {
 103         if ($seen{$_}++ > 100) {
 104                 $endless_loop = 1;
 105                 $msg .= "\n$text{'install_loop'}\n";
 106                 last;
 107                 }
 108         while(length($_) > 100) {
 109                 s/^(.{100})//;
 110                 $msg .= &html_escape($1)."\n";
 111                 }
 112         $msg .= &html_escape($_);
 113         }
 114 close(CMD);
 115 $msg .= "</pre>";
 116 print &ui_table_row(undef, $msg, 2);
 117 print &ui_table_end();
 118 return $? || $endless_loop ? 0 : 1;
 119 }
 120
 121 sub build_error
 122 {
 123 print "<p>",&text('install_err', "<tt>$mods[$i]</tt>"),"<br>\n";
 124 if ($in{'source'} == 3) {
 125         print &text('install_err2', "<tt>perl -MCPAN -e shell</tt>"),"\n";
 126         }
 127 print "<p>\n";
 128 if ($in{'need_unlink'} && $config{'save_partial'}) {
 129         # File needs to be deleted
 130         print &text('install_needunlink',
 131                 "delete_file.cgi?".
 132                 join("&", map { "file=".&urlize($_) } @pfile)),"<p>\n";
 133         }
 134 &clean_up(0);
 135 exit;
 136 }
 137