package cmdline; use strict; require Exporter; @cmdline::ISA = qw(Exporter); @cmdline::EXPORT = qw( parse_cmdline print_usage ); use logging; sub store_option_value ($$$) { my ($spec, $arg, $value) = @_; my $storeinto = $$spec{StoreInto}; if (defined $storeinto && ref($storeinto) eq 'SCALAR') { print_log('global', DEBUG1, 'Storing option %s value: %s', $arg, $value); $$storeinto = $value; } my $storefunc = $$spec{StoreFunc}; if (defined $storefunc && ref($storefunc) eq 'CODE') { print_log('global', DEBUG1, 'Storing option %s value: %s', $arg, $value); &{$storefunc}($value); } } sub check_option_value ($$$) { my ($spec, $arg, $value) = @_; my $type = $$spec{Type}; if ($type eq 'integer') { if ($value !~ /^\d+$/o) { print STDERR 'Invalid integer parameter for option '.$arg.': '.$value."\n"; return 0; } } if ($type eq 'keyvalue') { if ($value !~ /^[^=]+=/o) { print STDERR 'Invalid key=value parameter syntax for option '.$arg.': '.$value."\n"; return 0; } } return 1; } sub parse_cmdline ($) { my ($specs) = @_; my $general = 0; my $found = {}; my $shorts = {}; my $longs = {}; foreach my $spec (@$specs) { $general++ if defined $$spec{General}; my $short = $$spec{Short}; my $long = $$spec{Long}; $$shorts{$short} = $spec if defined $short; $$longs{$long} = $spec if defined $long; } my $left = []; my $i = 0; my $options = 1; while (1) { my $arg = $ARGV[$i++]; last unless defined $arg; print_log('global', DEBUG2, 'Checking argument %s', $arg); if ($options && $arg =~ /^--(.*)$/o) { my $long = $1; if ($long eq '') { print_log('global', DEBUG2, 'No more options'); $options = 0; next; } my $spec = $$longs{$long}; if (! defined $spec) { print STDERR 'Unknown long option: '.$arg."\n"; return undef; } print_log('global', DEBUG2, 'Found long option: %s', $long); my $param; if ($$spec{Type} eq 'flag') { $param = 1; } else { $param = $ARGV[$i++]; if (! defined $param) { print STDERR 'Missing parameter for long option: '.$arg."\n"; return undef; } return undef unless check_option_value($spec, $arg, $param); } $$found{$arg} = 1; store_option_value($spec, $arg, $param); next; } if ($options && $arg =~ /^-(.*)$/o) { my $list = $1; my $j = 0; while ($j < length($list)) { my $short = substr($list, $j++, 1); if ($short eq '-') { print_log('global', DEBUG2, 'No more options'); $options = 0; next; } my $opt = '-'.$short; my $spec = $$shorts{$short}; if (! defined $spec) { print STDERR 'Unknown short option: '.$opt."\n"; return undef; } print_log('global', DEBUG2, 'Found short option: %s', $short); my $param; if ($$spec{Type} eq 'flag') { $param = 1; } else { $param = $ARGV[$i++]; if (! defined $param) { print STDERR 'Missing parameter for short option: '.$opt."\n"; return undef; } return undef unless check_option_value($spec, $opt, $param); } $$found{$opt} = 1; store_option_value($spec, $opt, $param); } next; } if (! $general) { print STDERR 'Unexpected general parameter: '.$arg."\n"; return undef; } print_log('global', DEBUG1, 'Adding general cli parameter %s', $arg); push @$left, $arg; } foreach my $spec (@$specs) { next if defined $$spec{General}; my $default = $$spec{Default}; next unless defined $default; my $arg; my $long = $$spec{Long}; if (defined $long) { $arg = '--'.$long; next if defined $$found{$arg}; } my $short = $$spec{Short}; if (defined $short) { $arg = '-'.$short; next if defined $$found{$arg}; } print_log('global', DEBUG1, 'Using default for option %s: %s', $arg, $default); store_option_value($spec, $arg, $default); } return $left; } sub print_usage ($) { my ($specs) = @_; my $general = ''; my $longest = 0; foreach my $spec (@$specs) { my $len = 0; if (defined $$spec{General}) { my $option = $$spec{Option}; my $optional = $$spec{Optional}; $optional = defined $optional && $optional; $len = length($option); $general .= ' '.($optional ? '[' : '').$option.($optional ? ']' : '') if $len > 0; } else { my $short = $$spec{Short}; my $long = $$spec{Long}; my $shortlen = defined $short ? length($short) + 1 : 0; my $longlen = defined $long ? length($long) + 2 : 0; $len = $shortlen + $longlen; $len += 2 if $shortlen > 0 && $longlen > 0; } $longest = $len if $len > $longest; } print STDERR 'Usage: '.$0.' []'.$general."\n"; foreach my $spec (@$specs) { my $buffer = ''; my $desc = $$spec{Description}; if (defined $$spec{General}) { my $option = $$spec{Option}; $buffer .= $option; } else { my $short = $$spec{Short}; my $long = $$spec{Long}; my $type = $$spec{Type}; $type = '['.$type.']' if defined $type; $desc = $desc.' '.$type if defined $type; my $default = $$spec{Default}; $default = 'set' if $type eq 'Flag' && defined $default && $default; $default = '(Default:'.$default.')' if defined $default; $desc = $desc.' '.$default if defined $default; $short = '-'.$short if defined $short; $long = '--'.$long if defined $long; $buffer .= $short if defined $short; $buffer .= ', ' if defined $short && defined $long; $buffer .= $long if defined $long; } $buffer .= ' ' x ($longest - length($buffer)) if length($buffer) < $longest; $buffer = ' '.$buffer; $buffer .= $longest + 4 + length($desc) < 80 ? ' '.$desc."\n" : "\n".' '.$desc."\n"; print STDERR $buffer } } 1;