File Coverage

blib/lib/Perl/Configure.pm

Criterion	Covered	Total	%
statement	32	57	56.1
branch	3	14	21.4
condition			n/a
subroutine	9	10	90.0
pod	0	3	0.0
total	44	84	52.3

package Perl::Configure;
use strict;
use warnings;

use Expect;
use Perl::Configure::Questions;
use Data::Dumper;
use YAML qw(Dump LoadFile);
use Log::Log4perl qw(:easy);

our $VERSION = '0.08';

###########################################
sub new {
###########################################
    my($class, @options) = @_;

    my $self = {
        exp       => Expect->new(),
        yml_file  => undef,
        timeout   => 600,
        questions => Perl::Configure::Questions->new(),
        @options
    };

    $self->{bk}        = $self->{questions}->by_key(),
    $self->{bp}        = $self->{questions}->by_pattern(),

    $self->{exp}->raw_pty(1);

    bless $self, $class;

    if(defined $self->{yml_file}) {
        my $data = LoadFile $self->{yml_file};
        $self->define(%$data);
    }

    return $self;
}

###########################################
sub define {
###########################################
    my($self, %args) = @_;

    for my $key (keys %args) {
        if(! exists $self->{bk}->{$key}) {
            LOGDIE "Unknown token: '$key'. Must be one of ",
                   join(", ", sort $self->{questions}->tokens()), ".";
        }
        $self->{define}->{$key} = $args{$key};
    }
}

###########################################
sub run {
###########################################
    my($self) = @_;

    unlink "Policy.sh";

    my @patterns = $self->{questions}->patterns();

    $self->{exp}->spawn("./Configure")
        or LOGDIE "Cannot spawn: $!\n";

    {   my ($matched_pattern_position, $error, $match,
            $before_match, $after_match) =
                $self->{exp}->expect(
                             $self->{timeout},
                             map { -re => $_ } @patterns);

        if(defined $match) {

            DEBUG "Match: [$match]";

            my $token = $self->{bp}->{
              $patterns[$matched_pattern_position-1]}->[0];

            if(! defined $token) {
                LOGDIE "Internal error: match($match) but no token: ",
                       "pos=$matched_pattern_position ",
                       "error=$error ",
                       "before=$before_match ",
                       "after=$after_match ",
                       ;
            }

            my $response = "";
            DEBUG "Entry for token '$token': ", Dumper($self->{bk}->{$token});

                # Grab default answer if existent
            my $override = $self->{bk}->{$token}->[2];
            $response = $override if defined $override;

            if(exists $self->{define}->{$token}) {
                $response = $self->{define}->{$token};
                INFO "Overriding with [$response]";
            } else {
                INFO "Filling in [DEFAULT=$response]";
            }

            DEBUG "Response: [$response]";
            $self->{exp}->send("$response\n");

            redo;
        }
    }
}

1;

__END__