winupd/cmdline.pm

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.' [<options>]'.$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;