home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / CPAN / FirstTime.pm next >
Text File  |  1997-11-25  |  11KB  |  403 lines
  1. package CPAN::Mirrored::By;
  2.  
  3. sub new { 
  4.     my($self,@arg) = @_;
  5.     bless [@arg], $self;
  6. }
  7. sub continent { shift->[0] }
  8. sub country { shift->[1] }
  9. sub url { shift->[2] }
  10.  
  11. package CPAN::FirstTime;
  12.  
  13. use strict;
  14. use ExtUtils::MakeMaker qw(prompt);
  15. use FileHandle ();
  16. use File::Path ();
  17. use vars qw($VERSION);
  18. $VERSION = substr q$Revision: 1.21 $, 10;
  19.  
  20. =head1 NAME
  21.  
  22. CPAN::FirstTime - Utility for CPAN::Config file Initialization
  23.  
  24. =head1 SYNOPSIS
  25.  
  26. CPAN::FirstTime::init()
  27.  
  28. =head1 DESCRIPTION
  29.  
  30. The init routine asks a few questions and writes a CPAN::Config
  31. file. Nothing special.
  32.  
  33. =cut
  34.  
  35.  
  36. sub init {
  37.     my($configpm) = @_;
  38.     use Config;
  39.     require CPAN::Nox;
  40.     eval {require CPAN::Config;};
  41.     $CPAN::Config ||= {};
  42.     local($/) = "\n";
  43.     local($\) = "";
  44.  
  45.     my($ans,$default,$local,$cont,$url,$expected_size);
  46.     
  47.     #
  48.     # Files, directories
  49.     #
  50.  
  51.     print qq{
  52. The CPAN module needs a directory of its own to cache important
  53. index files and maybe keep a temporary mirror of CPAN files. This may
  54. be a site-wide directory or a personal directory.
  55. };
  56.  
  57.     my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
  58.     if (-d $cpan_home) {
  59.     print qq{
  60.  
  61. I see you already have a  directory
  62.     $cpan_home
  63. Shall we use it as the general CPAN build and cache directory?
  64.  
  65. };
  66.     } else {
  67.     print qq{
  68.  
  69. First of all, I\'d like to create this directory. Where?
  70.  
  71. };
  72.     }
  73.  
  74.     $default = $cpan_home;
  75.     while ($ans = prompt("CPAN build and cache directory?",$default)) {
  76.     File::Path::mkpath($ans); # dies if it can't
  77.     if (-d $ans && -w _) {
  78.         last;
  79.     } else {
  80.         warn "Couldn't find directory $ans
  81.   or directory is not writable. Please retry.\n";
  82.     }
  83.     }
  84.     $CPAN::Config->{cpan_home} = $ans;
  85.     
  86.     print qq{
  87.  
  88. If you want, I can keep the source files after a build in the cpan
  89. home directory. If you choose so then future builds will take the
  90. files from there. If you don\'t want to keep them, answer 0 to the
  91. next question.
  92.  
  93. };
  94.  
  95.     $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
  96.     $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
  97.  
  98.     #
  99.     # Cache size, Index expire
  100.     #
  101.  
  102.     print qq{
  103.  
  104. How big should the disk cache be for keeping the build directories
  105. with all the intermediate files?
  106.  
  107. };
  108.  
  109.     $default = $CPAN::Config->{build_cache} || 10;
  110.     $ans = prompt("Cache size for build directory (in MB)?", $default);
  111.     $CPAN::Config->{build_cache} = $ans;
  112.  
  113.     # XXX This the time when we refetch the index files (in days)
  114.     $CPAN::Config->{'index_expire'} = 1;
  115.  
  116.     #
  117.     # External programs
  118.     #
  119.  
  120.     print qq{
  121.  
  122. The CPAN module will need a few external programs to work
  123. properly. Please correct me, if I guess the wrong path for a program.
  124. Don\'t panic if you do not have some of them, just press ENTER for
  125. those.
  126.  
  127. };
  128.  
  129.     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
  130.     my $prog;
  131.     for $prog (qw/gzip tar unzip make lynx ncftp ftp/){
  132.     my $path = $CPAN::Config->{$prog} || "";
  133.     if (MM->file_name_is_absolute($path)) {
  134.         warn "Warning: configured $path does not exist\n" unless -e $path;
  135.         $path = "";
  136.     } else {
  137.         $path = '';
  138.     }
  139.     $path ||= find_exe($prog,[@path]);
  140.     warn "Warning: $prog not found in PATH\n" unless -e $path;
  141.     $ans = prompt("Where is your $prog program?",$path) || $path;
  142.     $CPAN::Config->{$prog} = $ans;
  143.     }
  144.     my $path = $CPAN::Config->{'pager'} || 
  145.     $ENV{PAGER} || find_exe("less",[@path]) || 
  146.         find_exe("more",[@path]) || "more";
  147.     $ans = prompt("What is your favorite pager program?",$path);
  148.     $CPAN::Config->{'pager'} = $ans;
  149.     $path = $CPAN::Config->{'shell'};
  150.     if (MM->file_name_is_absolute($path)) {
  151.     warn "Warning: configured $path does not exist\n" unless -e $path;
  152.     $path = "";
  153.     }
  154.     $path ||= $ENV{SHELL};
  155.     $ans = prompt("What is your favorite shell?",$path);
  156.     $CPAN::Config->{'shell'} = $ans;
  157.  
  158.     #
  159.     # Arguments to make etc.
  160.     #
  161.  
  162.     print qq{
  163.  
  164. Every Makefile.PL is run by perl in a separate process. Likewise we
  165. run \'make\' and \'make install\' in processes. If you have any parameters
  166. \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
  167. the calls, please specify them here.
  168.  
  169. If you don\'t understand this question, just press ENTER.
  170.  
  171. };
  172.  
  173.     $default = $CPAN::Config->{makepl_arg} || "";
  174.     $CPAN::Config->{makepl_arg} =
  175.     prompt("Parameters for the 'perl Makefile.PL' command?",$default);
  176.     $default = $CPAN::Config->{make_arg} || "";
  177.     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
  178.  
  179.     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
  180.     $CPAN::Config->{make_install_arg} =
  181.     prompt("Parameters for the 'make install' command?",$default);
  182.  
  183.     #
  184.     # Alarm period
  185.     #
  186.  
  187.     print qq{
  188.  
  189. Sometimes you may wish to leave the processes run by CPAN alone
  190. without caring about them. As sometimes the Makefile.PL contains
  191. question you\'re expected to answer, you can set a timer that will
  192. kill a 'perl Makefile.PL' process after the specified time in seconds.
  193.  
  194. If you set this value to 0, these processes will wait forever. This is
  195. the default and recommended setting.
  196.  
  197. };
  198.  
  199.     $default = $CPAN::Config->{inactivity_timeout} || 0;
  200.     $CPAN::Config->{inactivity_timeout} =
  201.     prompt("Timeout for inacivity during Makefile.PL?",$default);
  202.  
  203.  
  204.     #
  205.     # MIRRORED.BY
  206.     #
  207.  
  208.     $local = 'MIRRORED.BY';
  209.     $local = MM->catfile($CPAN::Config->{keep_source_where},"MIRRORED.BY") unless -f $local;
  210.     if (@{$CPAN::Config->{urllist}||[]}) {
  211.     print qq{
  212. I found a list of URLs in CPAN::Config and will use this.
  213. You can change it later with the 'o conf urllist' command.
  214.  
  215. }
  216.     } elsif (
  217.          -s $local
  218.          &&
  219.          -M $local < 30
  220.         ) {
  221.     read_mirrored_by($local);
  222.     } else {
  223.     $CPAN::Config->{urllist} ||= [];
  224.     while (! @{$CPAN::Config->{urllist}}) {
  225.         my($input) = prompt(qq{
  226. We need to know the URL of your favorite CPAN site.
  227. Please enter it here:});
  228.         $input =~ s/\s//g;
  229.         next unless $input;
  230.         my($wanted) = "MIRRORED.BY";
  231.         print qq{
  232. Testing "$input" ...
  233. };
  234.         push @{$CPAN::Config->{urllist}}, $input;
  235.         CPAN::FTP->localize($wanted,$local,"force");
  236.         if (-s $local) {
  237.         print qq{
  238. "$input" seems to work
  239. };
  240.         } else {
  241.         my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
  242.         last unless $ans =~ /^n/i;
  243.         pop @{$CPAN::Config->{urllist}};
  244.         }
  245.     }
  246.     }
  247.  
  248.     unless (@{$CPAN::Config->{'wait_list'}||[]}) {
  249.     print qq{
  250.  
  251. WAIT support is available as a Plugin. You need the CPAN::WAIT module
  252. to actually use it.  But we need to know your favorite WAIT server. If
  253. you don\'t know a WAIT server near you, just press ENTER.
  254.  
  255. };
  256.     $default = "wait://ls6.informatik.uni-dortmund.de:1404";
  257.     $ans = prompt("Your favorite WAIT server?\n  ",$default);
  258.     push @{$CPAN::Config->{'wait_list'}}, $ans;
  259.     }
  260.  
  261.     print qq{
  262.  
  263. If you\'re accessing the net via proxies, you can specify them in the
  264. CPAN configuration or via environment variables. The variable in
  265. the \$CPAN::Config takes precedence.
  266.  
  267. };
  268.  
  269.     for (qw/ftp_proxy http_proxy no_proxy/) {
  270.     $default = $CPAN::Config->{$_} || $ENV{$_};
  271.     $CPAN::Config->{$_} = prompt("Your $_?",$default);
  272.     }
  273.  
  274.     # We don't ask that now, it will be noticed in time, won't it?
  275.     $CPAN::Config->{'inhibit_startup_message'} = 0;
  276.     $CPAN::Config->{'getcwd'} = 'cwd';
  277.  
  278.     print "\n\n";
  279.     CPAN::Config->commit($configpm);
  280. }
  281.  
  282. sub find_exe {
  283.     my($exe,$path) = @_;
  284.     my($dir);
  285.     #warn "in find_exe exe[$exe] path[@$path]";
  286.     for $dir (@$path) {
  287.     my $abs = MM->catfile($dir,$exe);
  288.     if (MM->maybe_command($abs)) {
  289.         return $abs;
  290.     }
  291.     }
  292. }
  293.  
  294. sub read_mirrored_by {
  295.     my($local) = @_;
  296.     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
  297.     my $fh = FileHandle->new;
  298.     $fh->open($local) or die "Couldn't open $local: $!";
  299.     while (<$fh>) {
  300.     ($host) = /^([\w\.\-]+)/ unless defined $host;
  301.     next unless defined $host;
  302.     next unless /\s+dst_(dst|location)/;
  303.     /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
  304.         ($continent, $country) = @location[-1,-2];
  305.     $continent =~ s/\s\(.*//;
  306.     /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
  307.     next unless $host && $dst && $continent && $country;
  308.     $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
  309.     undef $host;
  310.     $dst=$continent=$country="";
  311.     }
  312.     $fh->close;
  313.     $CPAN::Config->{urllist} ||= [];
  314.     if ($expected_size = @{$CPAN::Config->{urllist}}) {
  315.     for $url (@{$CPAN::Config->{urllist}}) {
  316.         # sanity check, scheme+colon, not "q" there:
  317.         next unless $url =~ /^\w+:\/./;
  318.         $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
  319.     }
  320.     $CPAN::Config->{urllist} = [];
  321.     } else {
  322.     $expected_size = 6;
  323.     }
  324.     
  325.     print qq{
  326.  
  327. Now we need to know, where your favorite CPAN sites are located. Push
  328. a few sites onto the array (just in case the first on the array won\'t
  329. work). If you are mirroring CPAN to your local workstation, specify a
  330. file: URL.
  331.  
  332. You can enter the number in front of the URL on the next screen, a
  333. file:, ftp: or http: URL, or "q" to finish selecting.
  334.  
  335. };
  336.  
  337.     $ans = prompt("Press RETURN to continue");
  338.     my $other;
  339.     $ans = $other = "";
  340.     my(%seen);
  341.     
  342.     my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
  343.     while () {
  344.     my(@valid,$previous_best);
  345.     my $fh = FileHandle->new;
  346.     $fh->open($pipe);
  347.     {
  348.         my($cont,$country,$url,$item);
  349.         my(@cont) = sort keys %all;
  350.         for $cont (@cont) {
  351.         $fh->print("    $cont\n");
  352.         for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
  353.             for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
  354.             my $t = sprintf(
  355.                     "      %-18s (%2d) %s\n",
  356.                     $country,
  357.                     ++$item,
  358.                     $url
  359.                        );
  360.             if ($cont =~ /^\[/) {
  361.                 $previous_best ||= $item;
  362.             }
  363.             push @valid, $all{$cont}{$country}{$url};
  364.             $fh->print($t);
  365.             }
  366.         }
  367.         }
  368.     }
  369.     $fh->close;
  370.     $previous_best ||= 1;
  371.     $default =
  372.         @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
  373.     $ans = prompt(
  374.               "\nSelect an$other ftp or file URL or a number (q to finish)",
  375.               $default
  376.              );
  377.     my $sel;
  378.     if ($ans =~ /^\d/) {
  379.         my $this = $valid[$ans-1];
  380.         my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
  381.         push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
  382.         delete $all{$con}{$cou}{$url};
  383.         #        print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
  384.     } elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
  385.         last;
  386.     } else {
  387.         $ans =~ s|/?$|/|; # has to end with one slash
  388.         $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
  389.         if ($ans =~ /^\w+:\/./) {
  390.         push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
  391.         } else {
  392.         print qq{"$ans" doesn\'t look like an URL at first sight.
  393. I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
  394. later and report a bug in my Makefile.PL to me (andreas koenig).
  395. Thanks.\n};
  396.         }
  397.     }
  398.     $other ||= "other";
  399.     }
  400. }
  401.  
  402. 1;
  403.