#! @PERL@ use warnings; # This script is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License version 2 as # published by the Free Software Foundation. # # See the COPYING and AUTHORS files for more details. use strict; my $opts = ''; my @words; my $found_sep = 0; foreach my $arg (@ARGV) { if (!$found_sep && $arg eq '--') { $found_sep = 1; } else { if (!$found_sep) { $opts .= ' ' . $arg; } else { push @words, $arg; } } } # there is no reason to parse # the opts if there are no args. if (!@words) { print " --\n"; exit; } my $short_opts = ''; my @long_opts; # nothing fancy to see here; this script provides minimal compatibility # with the getopt from util-linux until a cross platform binary exists. # We silently ignore option -q. if ($opts =~ /^\s*(?:-q\s+)?-o ([a-zA-Z:]*)?(\s+--long .*)*/) { $short_opts = $1; if ($2) { my $long_opts = $2; $long_opts =~ s/^\s*--long //g; $long_opts =~ s/ --long /,/g; @long_opts = split(/,/,$long_opts); } } my @barewords = ('--'); my @options; # set the previous option name when a param is required my $need_param; sub quote_word { my $word = shift; $word =~ s/'/'\\''/; return "'$word'"; } # there can be a second separator, to inhibit processing following arguments # as options $found_sep = 0; foreach my $word (@words) { if ($word eq '--') { $found_sep = 1; next; } # allow '-' to be an option value if ($found_sep || (!$need_param && $word !~ /^-./)) { push @barewords, quote_word($word); next; } if ($need_param) { die "expecting param for $need_param" if $word =~ /^-./; push @options, quote_word($word); $need_param = undef; next; } # process short options if ($word =~ s/^-([^-])/$1/) { my @letters = reverse(split(//,$word)); while (@letters) { my $letter = pop @letters; my $found = grep(/$letter/, $short_opts); push @options, '-'.$letter; die "illegal option: $letter" if !$found; # handle options with optional parameters if (grep(/${letter}::/, $short_opts)) { if (scalar(@letters) == 0) { push @options, quote_word(''); } else { # what looked like more short options # are in fact the optional parameters push @options, quote_word(join('', reverse @letters)); } last; } # handle options with mandatory parameters if (grep(/$letter:/, $short_opts)) { if (scalar(@letters) == 0) { $need_param = $letter; } else { # short options can have args # embedded in the short option list push @options, quote_word(join('', reverse @letters)); @letters = (); } } } } # process long options if ($word =~ s/^--//) { my $param = ''; if ($word =~ /(.*)=(.*)/) { $word = $1; $param = $2; } my ($found) = grep(/^$word:{0,2}$/,@long_opts); die "illegal option: $word" if !$found; die "$word: unexpected paramater $param" if $found !~ /:$/ && $param ne ''; $need_param = $word if $found =~ /[^:]:$/ && $param eq ''; push @options, "--$word"; push @options, quote_word($param) if $param || $found =~ /::$/; } } print " @options @barewords\n"