Interrogando al Usuario

Makefile.PL es un programa Perl y por tanto puede - en caso de duda - cuestionar al usuario sobre decisiones que se refieren a la instalación. El siguiente ejemplo pertenece a la distribución de Net::SSH::Perl:

# $Id: Makefile.PL,v 1.28 2005/02/20 19:56:02 dbrobins Exp $

use strict;
use 5.006;
use ExtUtils::MakeMaker qw(prompt WriteMakefile);

my %prereq = (
        'Digest::MD5'       => 0,
        'IO::Socket'        => 0,
);

my %SSH_PREREQ = (
    1 => {
        'String::CRC32'     => '1.2',
        'Math::GMP'         => '1.04',
        'Scalar::Util'      => 0,
    },

    2 => {
        'Digest::SHA1'      => '2.10',
        ..................  => ......,
    },
);

$SSH_PREREQ{3} = { map %{$SSH_PREREQ{$_}}, 1..2 };

print<<MSG;
This is Net::SSH::Perl.

As of version 1.00, Net::SSH::Perl supports both the SSH1 and
SSH2 protocols natively. The two protocols have different
module prerequisitives, so you need to decide which protocol(s)
................................................................

MSG

printf "    [%d] SSH%d\n", $_, $_ for 1..2;
printf "    [3] Both SSH1 and SSH2\n";

my $p = prompt("\nWhich protocol(s) do you plan to use?", 3);
print "\n";

@prereq{keys %{$SSH_PREREQ{$p}}} = values %{$SSH_PREREQ{$p}};

my @cryptmod = (
    [ 'IDEA', 'Crypt::IDEA' ],
    [ 'DES','Crypt::DES' ],
    [ 'DES3', 'Crypt::DES' ],
    [ 'Blowfish', 'Crypt::Blowfish' ],
    [ 'RC4', '' ],
);

print<<MSG;
Some of the Net::SSH::Perl ciphers depend on a Crypt:: module from
....................................................................

MSG

my $i = 1;
for my $ciph(sort { $a->[0] <=> $b->[0] } @cryptmod) {
        printf "    [%d] %s\n", $i++, $ciph->[0];
}
my $c = prompt("\nEnter your choices, separated by spaces:", 1);
print "\n";

for my $id(split /\s+/, $c) {
        next unless $cryptmod[$id-1]->[1];
        $prereq{$cryptmod[$id-1]->[1]} = '0';
}

print "Checking for optional modules\n\n";

unless (have_module('Digest::BubbleBabble', 0.01)) {
        print<<MSG, "\n";
Digest::BubbleBabble is required if you want to generate bubble babble
key fingerprints with pssh-keygen.
MSG

        if (read_yes_or_no("Would you like to install it? (y/n)", "y")) {
                $prereq{'Digest::BubbleBabble'} = '0.01';
        }
        print "\n";
}

unless (have_module('Crypt::RSA', 1.37)) {
        print<<MSG, "\n";
Crypt::RSA is required if you wish to use the ssh-rsa public
key algorithm (ssh-dss is used by default).
MSG
        if (read_yes_or_no("Would you like to install it? (y/n)", "y")) {
                $prereq{'Crypt::RSA'} = '1.37';
        }
        print "\n";
}

WriteMakefile(
    NAME => 'Net::SSH::Perl',
    DISTNAME => 'Net-SSH-Perl',
    VERSION_FROM => 'lib/Net/SSH/Perl.pm',
    PREREQ_PM    => \%prereq,
    AUTHOR => 'David Robins <dbrobins@cpan.org>',
    ABSTRACT => 'Perl client interface to SSH',
);

sub read_yes_or_no {
    my($prompt, $def) = @_;
    my $ans = prompt($prompt, $def);
    $ans =~ /^y/i;
}

sub have_module {
    my($name, $ver) = @_;
    eval("use $name" . ($ver ? " $ver;" : ";"));
    !$@;
}
El ejemplo muestra el uso de la función prompt que permite preguntar al usuario.

Casiano Rodríguez León
Licencia de Creative Commons
Principios de Programación Imperativa, Funcional y Orientada a Objetos Una Introducción en Perl/Una Introducción a Perl
por Casiano Rodríguez León is licensed under a Creative Commons Reconocimiento 3.0 Unported License.

Permissions beyond the scope of this license may be available at http://campusvirtual.ull.es/ocw/course/view.php?id=43.
2012-06-19