package Mkcd::Commandline;

sub parseCommandLine;
sub usage;

our $VERSION = '0.0.1';

use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(parseCommandLine usage);

=head1 NAME

commandline - mkcd module

=head1 SYNOPSYS

    require Mkcd::Commandline;

=head1 DESCRIPTION

C<Mkcd::Commandline> include the mkcd command line parsing functions.

=head1 SEE ALSO

mkcd

=head1 COPYRIGHT

Copyright (C) 2000,2001 MandrakeSoft <warly@mandrakesoft.com>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

=cut

sub parseCommandLine {
	my ($name, $args, $par) = @_;

	my %params;
	foreach (@$par) {
		$_->[0] and $params{$_->[0]} = $_;
		$_->[1] and $params{$_->[1]} = $_
	    }

	my $params;
	foreach (@$par) { $_->[0] and $params .= $_->[0] }

	@$args or usage($name,$par,1);

	my @todo;
	my $onlyarg;

	my $a;
	my @default;
	while (@$args || $a){
		$_ = $a ? $a : shift @$args;
		$a = 0;
		my @cur;
		if ($onlyarg){
		    push @default, $_
		} elsif ($params && /^-([$params]+)$/){
		    my @letter = split / */, $1; 
		    push @cur, @letter;
		} elsif (/^--(.+)/ and $params{$1}) { 
		    push @cur, $1 
		} elsif (/^--$/) { 
		    $onlyarg = 1 
		} else { push @default, $_ } 
		foreach my $s (@cur){
			$params{$s} or usage($name,$par,"$s, not such option");
			my $tmp = getArgs($name,$s,$args,\%params,$par);
			push @todo, [$params{$s}->[5], $tmp, $params{$s}->[6]]
		}
	}
	my $tmp = getArgs($name,$name,\@default,\%params,$par);
	unshift @todo, [$params{$name}->[5], $tmp, $params{$name}->[6]];
	push @$args, @default;
	return \@todo
}

sub getArgs{
    my ($name,$s,$args,$params,$par) = @_;
    my $i = $params->{$s}[2]; 
    my $tmp = [];
    if (ref $i){
	foreach my $f (@{parseCommandLine($params->{$s}[1],$args,$i)}){
	    &{$f->[0]}($tmp,@{$f->[1]}) or print "ERROR getArgs: $f->[2]\n";
	}
    } else {
	if ($i < 0){ 
	    while ($i++) { 
		$a = shift @$args;
		length $a or usage($name,$par,"$s not enough argument");
		$a =~ /^-./ and usage($name,$par,"$s before $a, not enough argument"); 
		push @$tmp, $a 
	    } 
	    while ($a = shift @$args) { 
		if ($a =~ /^-./) { 
		    unshift @$args, $a ; 
		    last 
		} 
		push @$tmp, $a;
		$a = 0 
	    }
	} else { 
	    while ($i--) { 
		$a = shift @$args;
		length $a or usage($name,$par,"$s, not enough argument");  
		$a =~ /^-./ and usage($name,$par,"$s, before $a, not enough argument"); 
		push @$tmp, $a; 
		$a = 0 
	    }
	}
    }
    return $tmp;
}

sub usage{
	my ($name, $par, $level) = @_;
	my $st;
	foreach (sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @$par) {
		if ($_->[1] eq $name) { 
		    $st = "\nusage
		$name $_->[3]
			$_->[4]

	options:
    
$st"; 
		    next
		}
		$_->[0] and $st .= "\t\t-$_->[0], --$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
		$_->[1] and $st .= "\t\t--$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
	}
	
	print "\nERROR $name: $level\n" if $level;
	print "$st\n";
	exit
}

1