view release on metacpan or  search on metacpan

Yagow.pm  view on Meta::CPAN

# Usage:
#   $opt->parse_cmd_line( '--opt1 val1', '--opt2 val2', ... );
#   $opt->parse_cmd_line( ... , '--optx valx', 
#                         { -msg=>$msg_help,-verbose=>1 },
#                         { -msg=>$msg_wrong_syntax,-verbose=>0 }  );
#   $opt->parse_cmd_line( ... , '--optx valx', 
#                         { -msg=>$msg_help,-verbose=>1 }          );
#   $opt->parse_cmd_line( ... , '--optx valx', 
#                         undef,
#                         { -msg=>$msg_wrong_syntax,-verbose=>0 }  );
#
sub parse_cmd_line
{
    my $this = shift;

    my $default_msg = "!! Incorrect syntax. Use --h for help !!.\n";

    my ($i,$arg,$help_usage,$wrong_syntax);

    # Cases:
    # 1.-   ...  , {...}, {...}
    # 3.-   ...  , undef, undef
    # 4.-   ...  , {...}, undef
    # 5.-   ...  , undef, {...}
    # 6.-   ...  , undef
    # 7.-   ...  , {...}
    # 2.-   {...}, {...}
    # 8.-   undef, undef
    # 9.-   undef, {...}
    # 10.-  {...}, undef
    # 11.-  {...}
    # 12.-  undef
    #
    my $hash_no = 1;
    for( $i = 0; $i <  @_; $i++ )
    {
        $arg = $_[$i];
        if( (defined $arg && ref $arg eq 'HASH') || !defined $arg )
        {            
            if( $hash_no == 1 )
            {
                $help_usage = $arg if defined $arg; 
                $hash_no = 2;
            }

            if( $hash_no == 2 )
            {
                $wrong_syntax = $arg if defined $arg;
                $hash_no = 3;
            }        
   
            splice @_,$i,1;  # Supress $arg from argument list.
            $i--;
        }
    }

    $wrong_syntax = {-msg=>$default_msg,-verbose=>0} if ! defined $wrong_syntax;
    $help_usage =   { -verbose => 1 } if ! defined $help_usage;

    my @args = @_ ? @_ : @ARGV;
    local (@ARGV) = @args;

    #
    # Handle command line parameters
    #
    my @options = values %{ $this->{options} };
    my %used = ();
    unless( GetOptions(\%used, 'help|h|?!', @options)) 
    {
        $this->usage( $wrong_syntax );
    }

    if( exists $used{help} ) 
    {
	$this->usage( $help_usage  );
    }

    # If execution reaches this, syntax is correct from the point of view of 
    # GetOptions, but we require that options with 'undef' default value be 
    # specified in command line.
    #
    foreach my $mandatory_opt ( @{$this->{mandatory}} )
    {
        if( ! exists $used{$mandatory_opt} )
        {
            warn "There is/are mandatory argument(s)";
            $this->usage( $wrong_syntax );
        }
    }
    # Also, options with default values, but used in command line, must be
    # deleted.
    foreach ( keys %{$this->{default}} )
    {
        delete $this->{default}->{$_} if exists $used{$_};
    }
    $this->{used} = \%used;

    # Debug:
    # print "# Getopt::Yagow. \@ARGV: ",join(',',@ARGV),"\n";

    $this->{unhandled_options} = [];
    push @{$this->{unhandled_options}}, @ARGV;

    return $this;
}

sub get_configuration
{
    my $this = shift;

    return ( exists $this->{configuration} ? $this->{configuration} : [] );
}

sub get_options
{
    my $this = shift;

    return $this->{options};
}

sub get_default