#! @PERL@ -w # 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,$args) = split(/ -- /, join(' ',@ARGV)); # there is no reason to parse # the opts if there are no args. if (! $args) { print ' -- '; 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. if ($opts =~ /^-o ([a-zA-Z:]*)( --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 @words=split(/\s+/,$args); my @barewords; my @options; # set the the previous option name when a param is required my $need_param; foreach my $word (@words) { # allow '-' to be an option value if (!$need_param && $word !~ /^-./) { push @barewords, $word; next; } if ($need_param) { die "expecting param for $need_param" if $word =~ /^-./; push @options, $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; if (grep(/$letter:/, $short_opts)) { if (scalar(@letters) == 0) { $need_param = $letter; } else { # short options can have numerical args # embedded in the short option list: -UO die "unexpected character after option $letter" if ($letters[$#letters] !~ /[0-9]/); my @digits; while (scalar(@letters) && ($letters[$#letters] =~ /[0-9]/)) { push @digits, pop @letters; } push @options, join('',reverse @digits); } } } } # process long options if ($word =~ s/^--//) { my $param = ''; if ($word =~ /(.*)=(.*)/) { $word = $1; $param = $2; } my ($found) = grep(/^$word:?$/,@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, $param if $param; } } print "@options -- @barewords"