File Coverage

blib/lib/Getopt/Mini.pm

Criterion	Covered	Total	%
statement	55	75	73.3
branch	26	36	72.2
condition	6	12	50.0
subroutine	7	9	77.7
pod	0	3	0.0
total	94	135	69.6

#
# This file is part of Getopt-Mini
#
# This software is copyright (c) 2015 by Rodrigo de Oliveira.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Getopt::Mini;
use strict;
use warnings;
use Encode qw();

our $VERSION = '0.03';

sub import {
    my $class = shift;
    my %args = @_;
    if( defined $args{var} ) {
        if( $args{var} !~ /::/ ) {
            my $where = caller(0);
            $args{var} = $where . '::' . $args{var};
        }
        my %hash = getopt( arrays=>0 );
        no strict 'refs';
        *{ $args{var} } = \%hash;
    }
    elsif( defined $args{later} ) {
        # import getopt() so that user can call it
        my $where = caller(0);
        no strict 'refs';
        *{ $where . '::getopt' } = \&getopt;
    }
    else {
        # into %ARGV
        getopt( arrays=>0 );
    }
    #unshift @ARGV, @barewords;
    return;
}

sub getopt_array {
    getopt( arrays=>1 , @_ );
}

sub getopt {
    my ( $last_opt, $last_done, %hash );
    my %opts;
    # get my own opts
    my @argv = @_ == 0
      ? @ARGV
      : do {
           %opts = @_;
           @{ delete $opts{argv} || [] };
      };
    if (not @argv){ push(@argv, Encode::decode('UTF-8' ,$_) ) for @ARGV; }
    return () unless @argv;
    $hash{_argv} = [ @argv ];
    while(@argv) {
        my $arg = shift @argv;
        if ( $arg =~ m/^-(\w)$/ ) {   # single letter
            my $flag = $1;
            if( $opts{hungry_flags} && defined $argv[0] && $argv[0] !~ /^-/ ) {
                $hash{$flag} = shift @argv;
            } else {
                $hash{$flag} ++;
            }
            $last_done= 1;
        }
        elsif ( $arg =~ m/^-+(.+)/ ) {
            $last_opt = $1;
            $last_done=0;
            if( $last_opt =~ m/^(.*)\=(.*)$/ ) {
                push @{ $hash{$1} }, $2 ;
                $last_done= 1;
            } else {
                $hash{$last_opt} = [] unless ref $hash{$last_opt};
            }
        }
        else {
            #$arg = Encode::encode_utf8($arg) if Encode::is_utf8($arg);
            $last_opt ='' if !$opts{arrays} && ( $last_done || ! defined $last_opt );
            push @{ $hash{$last_opt} }, $arg;
            $last_done = 1;
        }
    }
    # convert single option => scalar
    for( keys %hash ) {
        next unless ref( $hash{$_} ) eq 'ARRAY';
        if( @{ $hash{$_} } == 0 ) {
            $hash{$_} = $opts{define} ? 1 : ();
        } elsif( @{ $hash{$_} } == 1 ) {
            $hash{$_} = $hash{$_}->[0];
        }
    }
    if( defined wantarray ) {
        return %hash;
    } else {
        %ARGV = %hash;
    }
}

sub getopt_validate {
    my %args = @_;
    $args{''}={isa=>'Any'};  # ignores this
    require Data::Validator;
    my $rule = Data::Validator->new( %args );
    @_ = ($rule, %ARGV );
    goto \&Data::Validator::validate;
}

1;

__END__