setup.pm

source of perl for linux application,

package CPANPLUS::Configure::Setup;

use strict;
use vars    qw(@ISA);

use base    qw[CPANPLUS::Internals::Utils];
use base    qw[Object::Accessor];

use Config;
use Term::UI;
use Module::Load;
use Term::ReadLine;


use CPANPLUS::Internals::Utils;
use CPANPLUS::Internals::Constants;
use CPANPLUS::Error;

use IPC::Cmd                    qw[can_run];
use Params::Check               qw[check];
use Module::Load::Conditional   qw[check_install];
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

### silence Term::UI
$Term::UI::VERBOSE = 0;

#Can't ioctl TIOCGETP: Unknown error
#Consider installing Term::ReadKey from CPAN site nearby
#        at http://www.perl.com/CPAN
#Or use
#        perl -MCPAN -e shell
#to reach CPAN. Falling back to 'stty'.
#        If you do not want to see this warning, set PERL_READLINE_NOWARN
#in your environment.
#'stty' is not recognized as an internal or external command,
#operable program or batch file.
#Cannot call `stty': No such file or directory at C:/Perl/site/lib/Term/ReadLine/

### setting this var in the meantime to avoid this warning ###
$ENV{PERL_READLINE_NOWARN} = 1;


sub new {
    my $class = shift;
    my %hash  = @_;

    my $tmpl = {
        configure_object => { },
        term             => { },
        backend          => { },
        autoreply        => { default => 0, },
        skip_mirrors     => { default => 0, },
        use_previous     => { default => 1, },
        config_type      => { default => CONFIG_USER },
    };

    my $args = check( $tmpl, \%hash ) or return;

    ### initialize object
    my $obj = $class->SUPER::new( keys %$tmpl );
    for my $acc ( $obj->ls_accessors ) {
        $obj->$acc( $args->{$acc} );
    }     
    
    ### otherwise there's a circular use ###
    load CPANPLUS::Configure;
    load CPANPLUS::Backend;

    $obj->configure_object( CPANPLUS::Configure->new() )
        unless $obj->configure_object;
        
    $obj->backend( CPANPLUS::Backend->new( $obj->configure_object ) )
        unless $obj->backend;

    ### use empty string in case user only has T::R::Stub -- it complains
    $obj->term( Term::ReadLine->new('') ) 
        unless $obj->term;

    ### enable autoreply if that was passed ###
    $Term::UI::AUTOREPLY = $obj->autoreply;

    return $obj;
}

sub init {
    my $self = shift;
    my $term = $self->term;
    
    ### default setting, unless changed
    $self->config_type( CONFIG_USER ) unless $self->config_type;
    
    my $save = loc('Save & exit');
    my $exit = loc('Quit without saving');
    my @map  = (
        # key on the display                        # method to dispatch to
        [ loc('Select Configuration file')      => '_save_where'        ],
        [ loc('Setup CLI Programs')             => '_setup_program'     ],
        [ loc('Setup CPANPLUS Home directory')  => '_setup_base'        ],
        [ loc('Setup FTP/Email settings')       => '_setup_ftp'         ],
        [ loc('Setup basic preferences')        => '_setup_conf'        ],
        [ loc('Setup installer settings')       => '_setup_installer'   ],
        [ loc('Select mirrors'),                => '_setup_hosts'       ],      
        [ loc('Edit configuration file')        => '_edit'              ],    
        [ $save                                 => '_save'              ],
        [ $exit                                 => 1                    ],             
    );

    my @keys = map { $_->[0] } @map;    # sorted keys
    my %map  = map { @$_     } @map;    # lookup hash
   
    PICK_SECTION: {
        print loc("
=================>      MAIN MENU       <=================        
        
Welcome to the CPANPLUS configuration. Please select which
parts you wish to configure

Defaults are taken from your current configuration.
If you would save now, your settings would be written to:
    
    %1
    
        ", $self->config_type );
    
        my $choice = $term->get_reply(
                            prompt  => "Section to configure:",
                            choices => \@keys,
                            default => $keys[0]
                        );       
               
        ### exit configuration?
        if( $choice eq $exit ) {
            print loc("
Quitting setup, changes will not be saved.
            ");
            return 1;
        }      
            
        my $method = $map{$choice};
        
        my $rv = $self->$method or print loc("
There was an error setting up this section. You might want to try again
        ");

        ### was it save & exit?
        if( $choice eq $save and $rv ) {
            print loc("
Quitting setup, changes are saved to '%1'
            ", $self->config_type 
            );
            return 1;
        }

        ### otherwise, present choice again
        redo PICK_SECTION;
    }  

    return 1;
}



### sub that figures out what kind of config type the user wants
sub _save_where {
    my $self = shift;
    my $term = $self->term;
    my $conf = $self->configure_object;


    ASK_CONFIG_TYPE: {
    
        print loc( q[  
Where would you like to save your CPANPLUS Configuration file?

If you want to configure CPANPLUS for this user only, 
select the '%1' option.
The file will then be saved in your homedirectory.

If you are the system administrator of this machine, 
and would like to make this config available globally, 
select the '%2' option.
The file will be then be saved in your CPANPLUS 
installation directory.

        ], CONFIG_USER, CONFIG_SYSTEM );
    

        ### ask what config type we should save to
        my $type = $term->get_reply(
                        prompt  => loc("Type of configuration file"),
                        default => $self->config_type || CONFIG_USER,
                        choices => [CONFIG_USER, CONFIG_SYSTEM],
                  );
    
        my $file = $conf->_config_pm_to_file( $type );
        
        ### can we save to this file?
        unless( $conf->can_save( $file ) ) {
            error(loc(
                "Can not save to file '%1'-- please check permissions " .
                "and try again", $file       
            ));
            
            redo ASK_CONFIG_FILE;
        } 
        
        ### you already have the file -- are we allowed to overwrite
        ### or should we try again?
        if ( -e $file and -w _ ) {
            print loc(q[
I see you already have this file:
    %1

If you continue & save this file, the previous version will be overwritten.

            ], $file );
            
            redo ASK_CONFIG_TYPE 
                unless $term->ask_yn(
                    prompt  => loc( "Shall I overwrite it?"),
                    default => 'n',
                );
        }
        
        print $/, loc("Using '%1' as your configuration type", $type);
        
        return $self->config_type($type);
    }            
}


### setup the build & cache dirs
sub _setup_base {
    my $self = shift;
    my $term = $self->term;
    my $conf = $self->configure_object;

    my $base = $conf->get_conf('base');
    my $home = File::Spec->catdir( $self->_home_dir, DOT_CPANPLUS );
    
    print loc("
CPANPLUS needs a directory of its own to cache important index
files and maybe keep a temporary mirror of CPAN files.  
This may be a site-wide directory or a personal directory.

For a single-user installation, we suggest using your home directory.

");

    my $where;
    ASK_HOME_DIR: {
        my $other = loc('Somewhere else');
        if( $base and ($base ne $home) ) {
            print loc("You have several choices:");

            $where = $term->get_reply(
                        prompt  => loc('Please pick one'),
                        choices => [$home, $base, $other],
                        default => $home,
                    );
        } else {
            $where = $base;
        }

        if( $where and -d $where ) {
            print loc("
I see you already have a directory:
    %1
    
            "), $where;

            my $yn = $term->ask_yn(
                            prompt  => loc('Should I use it?'),
                            default => 'y',
                        );
            $where = '' unless $yn;
        }

        if( $where and ($where ne $other) and not -d $where ) {
            if (!$self->_mkdir( dir => $where ) ) {
                print   "\n", loc("Unable to create directory '%1'", $where);
                redo ASK_HOME_DIR;
            }

        } elsif( not $where or ($where eq $other) ) {
            print loc("
First of all, I'd like to create this directory.

            ");

            NEW_HOME: {
                $where = $term->get_reply(
                                prompt  => loc('Where shall I create it?'),
                                default => $home,
                            );

                my $again;
                if( -d $where and not -w _ ) {
                    print "\n", loc("I can't seem to write in this directory");
                    $again++;
                } elsif (!$self->_mkdir( dir => $where ) ) {
                    print "\n", loc("Unable to create directory '%1'", $where);
                    $again++;
                }

                if( $again ) {
                    print "\n", loc('Please select another directory'), "\n\n";
                    redo NEW_HOME;
                }
            }
        }
    }

    ### tidy up the path and store it
    $where = File::Spec->rel2abs($where);
    $conf->set_conf( base => $where );

    ### create subdirectories ###
    my @dirs =
        File::Spec->catdir( $where, $self->_perl_version(perl => $^X),
                            $conf->_get_build('moddir') ),
        map {
            File::Spec->catdir( $where, $conf->_get_build($_) )
        } qw[autdir distdir];

    for my $dir ( @dirs ) {
        unless( $self->_mkdir( dir => $dir ) ) {
            warn loc("I wasn't able to create '%1'", $dir), "\n";
        }
    }

    ### clear away old storable images before 0.031
    for my $src (qw[dslip mailrc packages]) {
        1 while unlink File::Spec->catfile( $where, $src );

    }

    print loc(q[
Your CPANPLUS build and cache directory has been set to:
    %1
    
    ], $where);

    return 1;
}

sub _setup_ftp {
    my $self = shift;
    my $term = $self->term;
    my $conf = $self->configure_object;

    #########################
    ## are you a pacifist? ##
    #########################

    print loc("
If you are connecting through a firewall or proxy that doesn't handle
FTP all that well you can use passive FTP.

");

    my $yn = $term->ask_yn(
                prompt  => loc("Use passive FTP?"),
                default => $conf->get_conf('passive'),
            );

    $conf->set_conf(passive => $yn);

    ### set the ENV var as well, else it won't get set till AFTER
    ### the configuration is saved. but we fetch files BEFORE that.
    $ENV{FTP_PASSIVE} = $yn;

    print "\n";
    print $yn
            ? loc("I will use passive FTP.")
            : loc("I won't use passive FTP.");
    print "\n";

    #############################
    ## should fetches timeout? ##
    #############################

    print loc("
CPANPLUS can specify a network timeout for downloads (in whole seconds).
If none is desired (or to skip this question), enter '0'.

");

    my $timeout = 0 + $term->get_reply(
                prompt  => loc("Network timeout for downloads"),
                default => $conf->get_conf('timeout') || 0,
                allow   => qr/(?!\D)/,            ### whole numbers only
            );

    $conf->set_conf(timeout => $timeout);

    print "\n";
    print $timeout
            ? loc("The network timeout for downloads is %1 seconds.", $timeout)
            : loc("The network timeout for downloads is not set.");
    print "\n";

    ############################
    ## where can I reach you? ##
    ############################

    print loc("