in reply to Parsing command line options without knowing what they are

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 }

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
RIP an inspiration; A true Folk's Guy

Replies are listed 'Best First'.
Re^2: Parsing command line options without knowing what they are
by DrWhy (Chaplain) on Nov 25, 2010 at 19:41 UTC
    Thanks, I may use some of the ideas in here for my own parser.

    --DrWhy

    "If God had meant for us to think for ourselves he would have given us brains. Oh, wait..."

      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; }

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
        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?

        --DrWhy

        "If God had meant for us to think for ourselves he would have given us brains. Oh, wait..."