File Coverage

blib/lib/Getopt/Long/Spec/Builder.pm

Criterion	Covered	Total	%
statement	50	54	92.5
branch	33	46	71.7
condition	12	27	44.4
subroutine	9	9	100.0
pod	2	2	100.0
total	106	138	76.8

use strict;
use warnings;

package Getopt::Long::Spec::Builder;
{
  $Getopt::Long::Spec::Builder::VERSION = '0.002';
}

# ABSTRACT: Build a Getopt::Long option spec from a set of attributes
use Carp;
use Data::Dumper;

our %DATA_TYPE_MAP = (
    integer => 'i',
    int     => 'i',
    string  => 's',
    str     => 's',
    float   => 'f',
    extint  => 'o',
    ext     => 'o',
);

our %DEST_TYPE_MAP = (
    'array'  => '@',
    'hash'   => '%',
    'scalar' => '',
);

sub new {
    my ( $class, %params ) = @_;
    my $self = bless {%params}, $class;
    return $self;
}

sub build {
    my ( $self, %params ) = @_;

    my $name_spec = $self->_build_name_spec( \%params );

    my $spec_type = $self->_spec_type( \%params );

    croak "default only valid when spec type is ':'\n"
        if $params{default_num} and $spec_type ne ':';

    my $arg_spec = ( $spec_type =~ /[:=]/ ) ? $self->_build_arg_spec( \%params ) : '';

    my $spec = $name_spec . $spec_type . $arg_spec;

    return $spec;
}

sub _build_name_spec {
    my ( $self, $params ) = @_;

    $params->{aliases} ||= [] unless exists $params->{aliases};
    croak "option parameter [aliases] must be an array ref\n"
        unless ref $params->{aliases} eq 'ARRAY';

    my $name_spec = join( '|',
        grep { defined $_ and length $_ }
        $params->{long},
        $params->{short},
        @{ $params->{aliases} }
    );

    return $name_spec;
}

sub _spec_type {
    my ( $self, $params ) = @_;

    # note: keep in mind - order is important here!
    return ':' if defined $params->{val_required} and $params->{val_required} == 0;
    return '=' if $params->{val_required};
    return '!' if $params->{negatable};
    return ''  unless defined $params->{opt_type};
    return '+' if $params->{opt_type} =~ '^incr';
    return ''  if $params->{opt_type} eq 'flag';
    return ':' if defined $params->{default_num}
        or defined $params->{val_type}
        or defined $params->{destination}
        or defined $params->{dest_type};

    die "Could not determine option type from spec!\n";
}

sub _build_arg_spec {
    my ( $self, $params ) = @_;

    my $val_type = $DATA_TYPE_MAP{ lc( $params->{val_type} || 'str' ) }
        or croak "invalid value type [$params->{val_type}]\n";

    # special cases for incremental opts or opts with default numeric value
    $val_type = $params->{default_num} if $params->{default_num};
    $val_type = '+' if $params->{opt_type} =~ /^incr/ and !$params->{val_type};

    # empty or missing destination type is allowable, so this accounts for that.
    my $dest_type = !$params->{dest_type} ? '' : $DEST_TYPE_MAP{ $params->{dest_type} };
    croak "invalid destination type [@{[ $params->{dest_type} || '' ]}]\n"
        unless defined $dest_type;

    # ah, the little-understood "repeat" clause
    my $repeat = '';
    if ( defined $params->{min_vals} || defined $params->{max_vals} ) {
        croak "repeat spec not valid when using default value\n" if $params->{default_num};
        $repeat .= '{';
        $repeat .= $params->{min_vals} if defined $params->{min_vals};
        $repeat .= "," . ( defined $params->{max_vals} ? $params->{max_vals} : '' )
            if exists $params->{max_vals};
        $repeat .= '}';
    }
    elsif ( defined $params->{num_vals} ) {
        $repeat .= "{$params->{num_vals}}";
    }

    return $val_type . $dest_type . $repeat;
}

1 && q{this is probably crazier than the last thing I wrote};  # truth


=pod

=head1 NAME

Getopt::Long::Spec::Builder - Build a Getopt::Long option spec from a set of attributes

=head1 VERSION

version 0.002

=head1 SYNOPSIS

This module builds a Getopt::Long option specification from a hash of option
parameters as would be returned by Getopt::Long::Spec::Parser->parse($spec)
and/or Getopt::Nearly::Everything->opt($opt_name)->attrs().

Here's an example of use:

    use Getopt::Long::Spec::Builder;

    my %opt_attrs = (
        opt_type       => 'simple'
        value_required => 1,
        value_type     => 'string',
        max_vals       => '5',
        dest_type      => 'array',
        min_vals       => '1',
        short          => [ 'f' ],
        long           => 'foo',
    );

    my $builder   = Getopt::Long::Spec::Builder->new();
    my $spec      = $builder->build( %opt_attrs );
    print $spec;  # output: 'foo|f=s@{1,5}'

    # OR...

    my $spec =
        Getopt::Long::Spec::Builder->build( %opt_attrs );

=head1 METHODS

=head2 new

Create a new builder object.

=head2 build

Build a Getopt::Long option specification from the attributes passed in
and return the spec as a string

=head1 SEE ALSO

=over 4

=item * Getopt::Long - info on option specifications

=item * Getopt::Long::Spec - parse and build GoL specifications

=item * Getopt::Long::Spec::Parser - parse GoL specifications

=item * Getopt::Nearly::Everything - the module for which this module was created

=back

=head1 AUTHOR

Stephen R. Scaffidi

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Stephen R. Scaffidi.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__