setup.pm

source of perl for linux application,

        ###################

        print loc("
Sometimes a module will require other modules to be installed before it
will work.  CPANPLUS can attempt to install these for you automatically
if you like, or you can do the deed yourself.

If you would prefer that we NEVER try to install extra modules
automatically, select NO.  (Usually you will want this set to YES.)

If you would like to build modules to satisfy testing or prerequisites,
but not actually install them, select BUILD.

NOTE: This feature requires you to flush the 'lib' cache for longer
running programs (refer to the CPANPLUS::Backend documentations for
more details).

Otherwise, select ASK to have us ask your permission to install them.

        ");

        my $type = 'prereqs';
        
        my @map = (
            [ PREREQ_IGNORE,                                # conf value 
              loc('No, do not install prerequisites'),      # UI Value   
              loc("I won't install prerequisites")          # diag message
            ],
            [ PREREQ_INSTALL,
              loc('Yes, please install prerequisites'),  
              loc("I will install prerequisites")     
            ],
            [ PREREQ_ASK,    
              loc('Ask me before installing a prerequisite'),  
              loc("I will ask permission to install") 
            ],
            [ PREREQ_BUILD,  
              loc('Build prerequisites, but do not install them'),
              loc( "I will only build, but not install prerequisites" )
            ],
        );
       
        my %reply = map { $_->[1] => $_->[0] } @map; # choice => value
        my %diag  = map { $_->[1] => $_->[2] } @map; # choice => diag message
        my %conf  = map { $_->[0] => $_->[1] } @map; # value => ui choice
        
        my $reply   = $term->get_reply(
                        prompt  => loc('Follow prerequisites?'),
                        default => $conf{ $conf->get_conf( $type ) },
                        choices => [ @conf{ sort keys %conf } ],
                    );
        print "\n";
        
        my $value = $reply{ $reply };
        my $diag  = $diag{  $reply };

        $conf->set_conf( $type => $value );
        print $diag, "\n";
    }

    {   print loc("
Modules in the CPAN archives are protected with md5 checksums.

This requires the Perl module Digest::MD5 to be installed (which
CPANPLUS can do for you later);

        ");
        my $type    = 'md5';
        
        my $yn = $term->ask_yn(
                    prompt  => loc("Shall I use the MD5 checksums?"),
                    default => $conf->get_conf( $type ),
                );

        print $yn
                ? loc("I will use the MD5 checksums if you have it")
                : loc("I won't use the MD5 checksums");

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

    }

    
    {   ###########################################
        ## sally sells seashells by the seashore ##
        ###########################################

        print loc("
By default CPANPLUS uses its own shell when invoked.  If you would prefer
a different shell, such as one you have written or otherwise acquired,
please enter the full name for your shell module.

        ");

        my $type    = 'shell';
        my $other   = 'Other';
        my @choices = (qw|  CPANPLUS::Shell::Default
                            CPANPLUS::Shell::Classic |, 
                            $other );
        my $default = $conf->get_conf($type);

        unshift @choices, $default unless grep { $_ eq $default } @choices;

        my $reply = $term->get_reply(
            prompt  => loc('Which CPANPLUS shell do you want to use?'),
            default => $default,
            choices => \@choices,
        );

        if( $reply eq $other ) {
            SHELL: {
                $reply = $term->get_reply(
                    prompt => loc(  'Please enter the name of the shell '.
                                    'you wish to use: '),
                );

                unless( check_install( module => $reply ) ) {
                    print "\n", 
                          loc("Could not find '$reply' in your path " .
                          "-- please try again"), 
                          "\n";
                    redo SHELL;
                }
            }
        }

        print "\n", loc("Your shell is now:   %1", $reply), "\n\n";

        $conf->set_conf( $type => $reply );
    }

    {
        ###################
        ## use storable? ##
        ###################

        print loc("
To speed up the start time of CPANPLUS, and maintain a cache over
multiple runs, we can use Storable to freeze some information.
Would you like to do this?

");
        my $type    = 'storable';
        my $yn      = $term->ask_yn(
                                prompt  => loc("Use Storable?"),
                                default => $conf->get_conf( $type ) ? 1 : 0,
                            );
        print "\n";
        print $yn
                ? loc("I will use Storable if you have it")
                : loc("I will not use Storable");

        $conf->set_conf( $type => $yn );
    }

    {
        ###################
        ## use cpantest? ##
        ###################

        print loc("
CPANPLUS has support for the Test::Reporter module, which can be utilized
to report success and failures of modules installed by CPANPLUS.  Would
you like to do this?  Note that you will still be prompted before
sending each report.

If you don't have all the required modules installed yet, you should
consider installing '%1'

This package bundles all the required modules to enable test reporting
and querying from CPANPLUS.
You can do so straight after this installation.

        ", 'Bundle::CPANPLUS::Test::Reporter');

        my $type = 'cpantest';
        my $yn   = $term->ask_yn(
                        prompt  => loc('Report test results?'),
                        default => $conf->get_conf( $type ) ? 1 : 0,
                    );

        print "\n";
        print $yn
                ? loc("I will prompt you to report test results")
                : loc("I won't prompt you to report test results");

        $conf->set_conf( $type => $yn );
    }

    {
        ###################################
        ## use cryptographic signatures? ##
        ###################################

        print loc("
The Module::Signature extension allows CPAN authors to sign their
distributions using PGP signatures.  Would you like to check for
module's cryptographic integrity before attempting to install them?
Note that this requires either the 'gpg' utility or Crypt::OpenPGP
to be installed.

        ");
        my $type = 'signature';

        my $yn = $term->ask_yn(
                            prompt  => loc('Shall I check module signatures?'),
                            default => $conf->get_conf($type) ? 1 : 0,
                        );

        print "\n";
        print $yn
                ? loc("Ok, I will attempt to check module signatures.")
                : loc("Ok, I won't attempt to check module signatures.");

        $conf->set_conf( $type => $yn );
    }

    return 1;
}

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


    if( scalar @{ $conf->get_conf('hosts') } ) {

        my $hosts;
        for my $href ( @{$conf->get_conf('hosts')} ) {
            $hosts .= "\t$href->{scheme}://$href->{host}$href->{path}\n";
        }

        print loc("
I see you already have some hosts selected:

$hosts

If you'd like to stick with your current settings, just select 'Yes'.
Otherwise, select 'No' and you can reconfigure your hosts

");
        my $yn = $term->ask_yn(
                        prompt  => loc("Would you like to keep your current hosts?"),
                        default => 'y',
                    );
        return 1 if $yn;
    }

    my @hosts;
    MAIN: {

        print loc("
Now we need to know where your favorite CPAN sites are located. Make a
list of a few sites (just in case the first on the array won't work).

If you are mirroring CPAN to your local workstation, specify a file:
URI by picking the CUSTOM option.

Otherwise, let us fetch the official CPAN mirror list and you can pick
the mirror that suits you best from a list by using the MIRROR option;
First, pick a nearby continent and country. Then, you will be presented
with a list of URLs of CPAN mirrors in the country you selected. Select
one or more of those URLs.

Note, the latter option requires a working net connection.

You can select VIEW to see your current selection and QUIT when you
are done.

");

        my $reply = $term->get_reply(
                        prompt  => loc('Please choose an option'),
                        choices => [qw|Mirror Custom View Quit|],
                        default => 'Mirror',
                    );

        goto MIRROR if $reply eq 'Mirror';
        goto CUSTOM if $reply eq 'Custom';
        goto QUIT   if $reply eq 'Quit';

        $self->_view_hosts(@hosts) if $reply eq 'View';
        redo MAIN;
    }

    my $mirror_file;
    my $hosts;
    MIRROR: {
        $mirror_file    ||= $self->_get_mirrored_by               or return;
        $hosts          ||= $self->_parse_mirrored_by($mirror_file) or return;

        my ($continent, $country, $host) = $self->_guess_from_timezone( $hosts );

        CONTINENT: {
            my %seen;
            my @choices =   sort map {
                                $_->{'continent'}
                            } grep {
                                not $seen{$_->{'continent'}}++
                            } values %$hosts;
            push @choices,  qw[Custom Up Quit];

            my $reply   = $term->get_reply(
                                prompt  => loc('Pick a continent'),
                                default => $continent,
                                choices => \@choices,
                            );

            goto MAIN   if $reply eq 'Up';
            goto CUSTOM if $reply eq 'Custom';
            goto QUIT   if $reply eq 'Quit';

            $continent = $reply;
        }

        COUNTRY: {
            my %seen;
            my @choices =   sort map {
                                $_->{'country'}
                            } grep {
                                not $seen{$_->{'country'}}++
                            } grep {
                                ($_->{'continent'} eq $continent)
                            } values %$hosts;
            push @choices,  qw[Custom Up Quit];

            my $reply   = $term->get_reply(
                                prompt  => loc('Pick a country'),
                                default => $country,
                                choices => \@choices,
                            );

            goto CONTINENT  if $reply eq 'Up';
            goto CUSTOM     if $reply eq 'Custom';
            goto QUIT       if $reply eq 'Quit';

            $country = $reply;
        }

        HOST: {
            my @list =  grep {
                            $_->{'continent'}   eq $continent and
                            $_->{'country'}     eq $country
                        } values %$hosts;

            my %map; my $default;
            for my $href (@list) {
                for my $con ( @{$href->{'connections'}} ) {
                    next unless length $con->{'host'};

                    my $entry   = $con->{'scheme'} . '://' . $con->{'host'};
                    $default    = $entry if $con->{'host'} eq $host;

                    $map{$entry} = $con;
                }
            }

            CHOICE: {
                
                ### doesn't play nice with Term::UI :(
                ### should make t::ui figure out pager opens
                #$self->_pager_open;     # host lists might be long
            
                print loc("
You can enter multiple sites by seperating them by a space.
For example:
    1 4 2 5
                ");    
            
                my @reply = $term->get_reply(
                                    prompt  => loc('Please pick a site: '),
                                    choices => [sort(keys %map), 
                                                qw|Custom View Up Quit|],
                                    default => $default,
                                    multi   => 1,
                            );
                #$self->_pager_close;
    

                goto COUNTRY    if grep { $_ eq 'Up' }      @reply;
                goto CUSTOM     if grep { $_ eq 'Custom' }  @reply;
                goto QUIT       if grep { $_ eq 'Quit' }    @reply;

                ### add the host, but only if it's not on the stack already ###
                unless(  grep { $_ eq 'View' } @reply ) {
                    for my $reply (@reply) {
                        if( grep { $_ eq $map{$reply} } @hosts ) {
                            print loc("Host '%1' already selected", $reply);
                            print "\n\n";
                        } else {
                            push @hosts, $map{$reply}
                        }
                    }
                }

                $self->_view_hosts(@hosts);

                goto QUIT if $self->autoreply;
                redo CHOICE;
            }
        }
    }

    CUSTOM: {
        print loc("
If there are any additional URLs you would like to use, please add them