File Coverage

blib/lib/Module/Install/TestVars.pm

Criterion	Covered	Total	%
statement	21	57	36.8
branch	0	16	0.0
condition	0	11	0.0
subroutine	7	9	77.7
pod	1	1	100.0
total	29	94	30.8

package Module::Install::TestVars;

use strict;
use warnings;

our $VERSION = '0.01_02';

use base qw(Module::Install::Base);

use Getopt::Long;
use Term::ReadLine;
use Term::UI;
use Text::ASCIITable;

sub test_vars {
    my ( $self, %config ) = @_;

    my $is_help = 0;

    GetOptions( 'help|h' => \$is_help, );

    my $term = Term::ReadLine->new('test_vars');
    my $out = $term->OUT || \*STDOUT;

    if ($is_help) {
        print $out 'Options: ', "\n\n";
        for my $var ( keys %config ) {
            $config{$var}->{prompt} ||= $var;

            print $out sprintf(
                "    %s : %s%s\n",
                $var,
                $config{$var}->{prompt},
                (
                    exists $config{$var}->{default}
                    ? sprintf( " (default: %s)", $config{$var}->{default} )
                    : ""
                )
            );
        }
        exit;
    }

 WIZARD:
    my %test_vars = map { ( split( /=/, $_, 2 ) ) } @ARGV;
    my $tbl = Text::ASCIITable->new( +{ headingText => 'test variables' } );
    $tbl->setCols( 'key', 'value' );

    print $out "Test configuration variables, \n\n";

    for my $var ( keys %config ) {
        unless ( exists $test_vars{$var} ) {
            $config{$var}->{prompt} ||= 'Input ' . $var;

            my %args = (
                (exists $config{$var}->{default})
                    ? (
                        prompt  => $config{$var}{prompt},
                        default => $config{$var}{default},
                    ) : (
                        prompt => $config{$var}{prompt},
                    ),
                ( exists $config{$var}->{choices} && ref $config{$var}->{choices} )
                    ? (
                        choices => $config{$var}{choices},
                        print_me => 'Choise number'
                    ) : (),
            );

            do {
                $test_vars{$var} = $term->get_reply(%args);
                $test_vars{$var} = $config{$var}{choices}->[$test_vars{$var} - 1] if (ref $config{$var}{choices});


            } until ( defined $test_vars{$var} );
        }
        else {
            print $out sprintf( "%s: %s\n", $var, $test_vars{$var} );
        }

        $tbl->addRow( $var, $test_vars{$var} );
    }

    print $out "\n", $tbl, "\n";

    unless (
        $term->ask_yn(
            prompt  => 'Check configuration, proceed?',
            default => 'y'
        )
      )
    {
        goto WIZARD;
    }

    %MY::TEST_VARS = (%test_vars);
}

package MY;
our %TEST_VARS = ();

sub test {
    my ( $self, %attrs ) = @_;
    my $vars = 'TEST_VARS='
      . join(
        ' ' => map { sprintf( '%s=%s', $_, $TEST_VARS{$_} ) }
          keys %TEST_VARS
      );
    my $section = $self->SUPER::test(%attrs);
    $section = $vars . "\n" . $section;
    $section =~ s|(PERL_DL_NONLAZY=1)|$1 \$\(TEST_VARS\)|g if ( length $vars );
    $section;
}

1;
__END__