view release on metacpan or  search on metacpan

lib/App/Base/Script/Common.pm  view on Meta::CPAN

Returns the value of a specified option. For example, getOption('help') returns
1 or 0 depending on whether the --help option was specified. For option types
which are non-boolean (see App::Base::Script::Option) the return value is the actual
string/integer/float provided on the common line - or undef if none was provided.

=cut

sub getOption {
    my $self   = shift;
    my $option = shift;

    if (exists($self->_option_values->{$option})) {
        return $self->_option_values->{$option};
    } else {
        die "Unknown option $option";
    }

}

=head2 run

Runs the script, returning the return value of __run

=cut

sub run {
    my $self = shift;

    # This is implemented by subclasses of App::Base::Script::Common
    $self->__run;
    return $self->return_value;
}

=head2 _parse_arguments

Parses the arguments in @ARGV, returning a hashref containing:

=over 4

=item -

The parsed arguments (that is, those that should remain in @ARGV)

=item -

The option values, as a hashref, including default values

=item -

Whether the parsing encountered any errors

=back

=cut

sub _parse_arguments {
    my $self = shift;
    my $args = shift;

    local @ARGV = (@$args);

    # Build the hash of options to pass to Getopt::Long
    my $options      = $self->all_options;
    my %options_hash = ();
    my %getopt_args  = ();

    foreach my $option (@$options) {
        my $id   = $option->name;
        my $type = $option->option_type;
        if ($type eq 'string') {
            $id .= '=s';
        } elsif ($type eq 'integer') {
            $id .= '=i';
        } elsif ($type eq 'float') {
            $id .= '=f';
        }

        my $scalar = $option->default;
        $getopt_args{$option->name} = \$scalar;
        $options_hash{$id} = \$scalar;
    }

    my $result        = GetOptions(%options_hash);
    my %option_values = map { $_ => ${$getopt_args{$_}} } (keys %getopt_args);
    return {
        parse_result  => $result,
        option_values => \%option_values,
        parsed_args   => \@ARGV
    };

}

=head2 __error

Dispatches its arguments to the subclass-provided error() method (see REQUIRED
SUBCLASS METHODS), then exits.

=cut

sub __error {
    my $self = shift;
    warn(join " ", @_);
    exit(-1);
}

no Moose::Role;
1;

__END__

=head1 USAGE

Invocation of a App::Base::Script::Common-based program is accomplished as follows:

=over 4

=item -

Define a class that derives (via 'use Moose' and 'with') from App::Base::Script::Common