File Coverage

blib/lib/Module/Start/Base.pm

Criterion	Covered	Total	%
statement	9	76	11.8
branch	0	26	0.0
condition	0	8	0.0
subroutine	3	15	20.0
pod	0	11	0.0
total	12	136	8.8

package Module::Start::Base;
use strict;
use warnings;

use Term::ReadLine;

sub new {
    my $self = bless {}, shift;
    while (@_) {
        my ($key, $value) = splice(@_, 0, 2);
        $self->$key($value);
    }
    return $self;
}

# XXX In the future support a config class override in the config file.
sub new_config_object {
    require Module::Start::Config;
    return Module::Start::Config->new;
}

sub exit {
    my ($self, $msg, $option) = (@_, '', '');
    chomp $msg;
    print "$msg\n" if $msg;
    print "Exiting...\n" unless $option eq -noExitMsg;
    CORE::exit;
}

# prompt a query and return true or false
sub p {
    my ($self, $query, $default) = @_;
    $query ||= '';
    $default ||= '';
    PROMPT: {
        my $answer = read_line($query . ' ');
        chomp $answer;
        $answer =~ s/^\s*(.*?)\s*$/$1/;
        $answer = $default unless length $answer;
        redo PROMPT unless length $answer;
        return $answer;
    }
}

sub q {
    my ($self, $query, $default) = @_;
    $query ||= '';
    $default ||= '';
    $query .=
        $default eq 'y' ? ' [Yn] ' :
        $default eq 'n' ? ' [yN] ' :
                          ' [yn] ';
    PROMPT: {
        my $answer = lc read_line($query);
        chomp $answer;
        $answer = $default unless $answer;
        redo PROMPT unless $answer =~ /^[yn]$/;
        return $answer =~ /y/;
    }
}

{
    $| = 1;
    my $rl;
    $rl = Term::ReadLine->new if -t STDOUT;
    sub read_line {
        my $query = shift;
        my $input;
        if ($rl) {
            $input = $rl->readline($query);
        }
        else {
            print $query;
            $input = readline();
        }
        if (not defined $input) {
            print "\n";
            CORE::exit;
        }
        $input .= "\n";
    }
}

sub read_data_files {
    my ($self, $package) = @_;
    my $hash;
    %$hash = $self->get_packed_files($package);
    return $hash;
}

sub get_packed_files {
    my ($self, $package) = @_;
    my $data = $self->data($package) or return;
    my @data = split $self->file_separator_regexp, $data;
    shift @data;
    return @data;
}

sub file_separator_regexp {
    return qr/^__+\[\s*(.+?)\s*\]__+\n/m;
}

sub data {
    my $self = shift;
    my $package = shift;
    local $SIG{__WARN__} = sub {};
    local $/;
    eval "package $package; ";
}

sub render_template {
    require Template;
    my ($self, $template, %vars) = @_;

    $vars{self} = $self;

    my $t = Template->new;

    my $output;
    eval {
        $t->process($template, \%vars, \$output) or die $t->error;
    };
    die "Template Toolkit error:\n$@" if $@;
    return $output;
}

1;

=head1 NAME

Module::Start::Base - Base class for Module::Start

=head1 SYNOPSIS