package GetOpt::OO;

use strict;

=pod TODO

Rationalise the option-passing method - I don't like the GNU or standard
methods very much.  Like XML (but NOT!), we need something that's parsed the
same no matter what the program actually does.  Well, GetOpt::OO already does
that, but it still tries to look like the traditional method, which is not
necessarily a good thing.

We could have alternative lexical schemes - e.g. a lispish one.

Prevent the command-line from calling any other methods apart from those we
want to make available, i.e. those listed in the short->long map.

=cut

sub import {
	my $pkg = shift;

	@_ or return;

	my $call_pkg = caller(0);
	@_ % 2 == 0 and do {
		my $all_short = 1;
		my $second;
		for (@_) {
			$second = !$second or next;
			if ($_ =~ /../) { $all_short = 0; last; }
		}
		$all_short;
	} or
		die "usage: use GetOpt::OO h => 'help', f => 'foo', s => 'long' ...";
		
	no strict 'refs';
	# TODO: how to get this line not to cause a warning?!
	%{"${call_pkg}::short_opt_to_long"} = @_;
}

sub new {
	my $package = shift;
	my $target = shift or
		die "usage: GetOpt::OO->new(\$target, s => 'long', ...)";
	bless {
		_getoptoo_target => $target,
		_getoptoo_short_opt_to_long => { @_ },
	}, $package;
}

sub argv {
	my $self = shift;
	my $target = $self->{_getoptoo_target} || $self;
	while (@_ and $_[0] =~ /^\-/) {
		(my $opt = shift) =~ s/^\-//;
		last if $opt eq "-";
		if ($opt eq "") {
			$target->can("stdio") or die "we don't understand `-' (for stdio)\n";
			$target->stdio;
		} else {
			my $long = $opt =~ s/^\-//;
			last if $opt eq "";
			my @args;
			if ($opt =~ s/^([^:=]+)=(.*)/$1/) {
				@args = $2;
			} elsif ($opt =~ s/^([^:=]+):(.*)/$1/) {
				if ($2 ne "") {
					push @args, $2;
				}
				while (@_ and $_[0] !~ /^-/) {
					push @args, shift;
				}
			} elsif (!$long and $opt =~ /../) {
				($opt, @args) = $opt =~ /(.)(.*)/;
			}
			$long or $opt = $target->short_opt_to_long($opt);
			$target->process_option($opt, @args);
		}
	}
	return @_;
}

sub short_opt_to_long {
	my $self = shift;
	my $target = $self->{_getoptoo_target} || $self;
	my $pkg = ref $self;
	my $short_opt = shift;
	$short_opt =~ /../ and
		die "short option `$short_opt' is not short!";

	my $long_opt = (
			$self->{_getoptoo_short_opt_to_long} ||
			do { no strict 'refs'; \%{"${pkg}::short_opt_to_long"} } ||
			{}
		)->{$short_opt};

	defined $long_opt or
		die "unrecognised short option `$short_opt'\n";
	$target->can($long_opt) or
		die "internal error: short option `$short_opt' maps to `$long_opt' but there is no corresponding method!\n";
	return $long_opt;
}

sub process_option {
	my $self = shift;
	my $target = $self->{_getoptoo_target} || $self;
	my $option = shift;
	$target->can($option) or
		die "unrecognised option `$option'\n";
	$target->$option(@_);
}

1