File Coverage

blib/lib/Common/CLI.pm

Criterion	Covered	Total	%
statement	92	126	73.0
branch	25	40	62.5
condition	5	9	55.5
subroutine	17	24	70.8
pod	12	12	100.0
total	151	211	71.5

package Common::CLI;

use warnings;
use strict;

use Carp qw(confess);
use Data::Dumper;
use Data::FormValidator;
use Getopt::Long;
use File::Basename qw(basename);

our $VERSION = '0.04';

sub new {
    my $class = shift;
    my $self  = {};
    bless $self, $class;
    $self->init(@_);
    return $self;
}

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

    #
    # This allow us to override hard coded arguments in constructor.
    #
    %args = $self->arguments() if !exists $args{profile};

    my ( $profile, $options, $help ) = __parse_profile( $args{profile} );
    $self->options($options);
    $self->profile($profile);
    $self->help($help);
    my $input = __parse_command_line_options($options);
    $self->input($input);
    return;
}

sub profile {
    my $self = shift;
    $self->{profile} = shift if @_;
    return $self->{profile};
}

sub options {
    my $self = shift;
    $self->{options} = shift if @_;
    return $self->{options};
}

sub help {
    my $self = shift;
    $self->{help} = shift if @_;
    return $self->{help};
}

sub input {
    my $self = shift;
    $self->{input} = shift if @_;
    return $self->{input};
}

sub validate_options {
    my $self = shift;

    my $results = Data::FormValidator->check( $self->input(), $self->profile() );

    if ( $results->has_invalid or $results->has_missing ) {
        return ( undef, [ $results->invalid ], [ $results->missing ] );
    }

    #
    # Data::FormValidator::Results->valid returns a hashref in scalar
    # context.
    #

    return scalar $results->valid;
}

sub run {
    my $self = shift;

    my ( $options, $invalid, $missing ) = $self->validate_options();

    #
    # We don't have suitable options to use, show invalid or missing
    # fields before displaying help and exiting.
    #

    if ( $invalid or $missing ) {
        __display_usage();
        __display_invalid($invalid) if $invalid;
        __display_missing($missing) if $missing;
        $self->display_help();
        exit(1);
    }

    if ( $options->{help} ) {
        __display_usage();
        $self->display_help();
        exit(0);
    }

    my $status = $self->main($options);

    return $status;
}

sub main {
    confess "main() must be overriden";
}

sub arguments {
    return ( profile => { optional => [ [ 'help', 'Displays this help' ], ], } );
}

sub merge_arguments {
    my ( $self, $left, $right ) = @_;

    for my $flag (qw( required optional )) {
        for ( @{ $right->{profile}{$flag} } ) {
            push @{ $left->{profile}{$flag} }, $_;
        }
    }

    for my $flag (qw( defaults constraint_methods )) {
        if ( $right->{profile}{$flag}
            and ref $right->{profile}{$flag} eq 'HASH' )
        {

            for ( keys %{ $right->{profile}{$flag} } ) {
                $left->{profile}{$flag}{$_} = $right->{profile}{$flag}{$_}
                  unless exists $left->{profile}{$flag}{$_};
            }
        }
    }

    return %$left;
}

sub display_help {
    my $self = shift;

    for my $item ( @{ $self->help } ) {
        my $message = '';
        $message .= " --" . $item->[0] . "\n";
        $message .= "\t" . $item->[1];

        if ( ${ $self->profile }{defaults}{ $item->[2] } ) {
            $message .= " (default: " . ${ $self->profile }{defaults}{ $item->[2] } . ")";
        }

        $message .= "\n";

        print $message;
    }
}

sub __parse_profile {
    my ($profile) = @_;

    my @options;
    my %profile;
    my @help;

    for my $spec (qw( optional required )) {
        next if !exists $profile->{$spec};
        if ( ref $profile->{$spec} eq 'ARRAY' ) {
            for ( @{ $profile->{$spec} } ) {
                next if ref ne 'ARRAY';

                # store help data
                my @help_data = ( $_->[0], $_->[1] );

                # store `Getopt::Long' description
                unshift @options, $_->[0];

                # remove `Getopt::Long' required data, store only the
                # required bits for `Data::FormValidator'
                ( $_ = $_->[0] ) =~ s/=.*$//;

                # store stripped option
                push @help_data, $_;
                push @help,      \@help_data;

                $profile{$spec} = [] if !exists $profile{$spec};
                unshift @{ $profile{$spec} }, $_;
            }
        }
    }

    for my $spec (qw( constraint_methods require_some defaults )) {
        next if !exists $profile->{$spec};
        next if ref $profile->{$spec} ne 'HASH';
        for my $k ( keys %{ $profile->{$spec} } ) {
            $profile{$spec}{$k} = $profile->{$spec}{$k};
        }
    }

    return ( \%profile, \@options, \@help );
}

sub __parse_command_line_options {
    my ($options) = @_;

    my %parsed_options;
    if ( !GetOptions( \%parsed_options, @{$options} ) ) {
        return;
    }
    return \%parsed_options;
}

sub __display_missing {
    my $missing = shift;

}

sub __display_invalid {
    my $invalid = shift;

}

sub __display_usage {
    my $name = basename($0);
    print "\nUsage: $0 OPTIONS\n\n";
}

1;

__END__