Re: Parsing command line options without knowing what they are

[BrowserUk]

I never use getOpts of any form, and rarely use programs that use those conventions, so I've probably missed some rules. And it would probably need to be invoked at BEGIN{} time to be effective, but it's easier to play with this way.

This is hardly exhaustively tested, but it might form the basis of something useful:

#! perl -lw
use strict;
use Data::Dump qw[ pp ];

sub getOpts {
    my %opts;
    my @toDelete;
    for( my $i=0; $i < @ARGV; ++$i ) {
        $_ = $ARGV[ $i ];
        if( m[^-(.)(.*)$] ) {
            my( $first, $rest ) = ( $1, $2 );
            push @toDelete, $i;
            if( ! defined $first ) {
                next;
            }
            elsif( $first eq '-' ) {
                if( $rest eq '') {
                    last;
                }
                if( $ARGV[ $i+1 ] =~ m[^-] ) {
                    if( $rest =~ m[^no(.+)$] ) {
                        $opts{ $1 } = 0;
                    }
                    else {
                        $opts{ $rest } = 1;
                    }
                }
                else {
                    $opts{ $rest } = $ARGV[ ++$i ];
                    push @toDelete, $i;
               }
            }
            else {
                $opts{ $_ } = 1 for $first, split'',$rest;
            }
        }
    }
    splice @ARGV, $_, 1 for reverse @toDelete;
    return %opts;
}

my %opts = getOpts();

print "@ARGV\n", pp \%opts;

__END__
c:\test>perl getOpts.pl -abc --def --ghi jkl -m -o fred bill --tuv wxy
+z
fred bill
{ a => 1, b => 1, c => 1, def => 1, ghi => "jkl", "m" => 1, o => 1, tu
+v => "wxyz" }

c:\test>perl getOpts.pl -abc --def --ghi jkl -m -- -o fred bill --tuv 
+wxyz
-o fred bill --tuv wxyz
{ a => 1, b => 1, c => 1, def => 1, ghi => "jkl", "m" => 1 }

c:\test>perl getOpts.pl -abc 12345 --def --ghi jkl -m -- -o fred bill 
+--tuv wxyz
12345 -o fred bill --tuv wxyz
{ a => 1, b => 1, c => 1, def => 1, ghi => "jkl", "m" => 1 }

c:\test>perl getOpts.pl -abc 12345 --def --ghi jkl -m -o fred bill --t
+uv wxyz
12345 fred bill
{ a => 1, b => 1, c => 1, def => 1, ghi => "jkl", "m" => 1, o => 1, tu
+v => "wxyz" }

c:\test>perl getOpts.pl -abc --def 12345 --ghi jkl -m -o fred bill --t
+uv wxyz
fred bill
{ a => 1, b => 1, c => 1, def => 12345, ghi => "jkl", "m" => 1, o => 1
+, tuv => "wxyz" }

c:\test>perl getOpts.pl -abc --def 12345 --noverbose --ghi jkl -m -o f
+red bill --tuv wxyz
fred bill
{ a => 1, b => 1, c => 1, def => 12345, ghi => "jkl", "m" => 1, o => 1
+, tuv => "wxyz", verbose => 0 }

c:\test>perl getOpts.pl -abc --def 12345 --noverbose --ghi jkl -m -o f
+red --o bill --tuv wxyz
fred
{ a => 1, b => 1, c => 1, def => 12345, ghi => "jkl", "m" => 1, o => "
+bill", tuv => "wxyz", verbose => 0 }

[DrWhy]

Thanks, I may use some of the ideas in here for my own parser.

[BrowserUk]

YW. I later looked inside some of the existing getopts modules to see what other rules they implement, and boy are they ever complicated. Reverse engineering the rules from them would be a nightmare.

Here's a slightly cleaner refactoring of the above:

sub getOpts {
    my %opts;
    my @toDelete;
    for( my $i=0; $i < @ARGV; ++$i ) {
        $_ = $ARGV[ $i ];
        if( m[^-(.)(.*)$] ) {
            my( $first, $rest ) = ( $1, $2 );
            push @toDelete, $i;
            next unless defined $first;
            if( $first ne '-' ) {
                $opts{ $_ } = 1 for $first, split'',$rest;
                next;
            }
            last if $rest eq '';
            if( $ARGV[ $i+1 ] !~ m[^-] ) {
                $opts{ $rest } = $ARGV[ ++$i ];
                push @toDelete, $i;
            }
            if( $rest =~ m[^no(.+)$] ) {
                $opts{ $1 } = 0;
            }
            else {
                $opts{ $rest } = 1;
            }
        }
    }
    splice @ARGV, $_, 1 for reverse @toDelete;
    return %opts;
}

[DrWhy]

Nice. Especially nice since I've been doing alot of refactoring like this the last few weeks on code written by much less experienced Perl programmers. I'm curious about this line, though:

            next unless defined $first;

I don't think it's ever possible for $first to be undefined. If the regex in your if matches, the first capture will always have to be one character long, right? Never undefined?