add Mkcd-Commandline1.1.0

1 files changed, 178 insertions, 0 deletions

diff --git a/Mkcd/Commandline.pm b/Mkcd/Commandline.pm
new file mode 100644
index 0000000..df62726
--- /dev/null
+++ b/Mkcd/Commandline.pm
@@ -0,0 +1,178 @@
+package Mkcd::Commandline;
+
+our $VERSION = '1.1.0';
+
+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,2002,2003,2004 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, $noexit) = @_;
+
+    my %params;
+    my ($params, $nb);
+    foreach (@$par) {
+	$_->[0] and $params{$_->[0]} = $_;
+	$_->[1] and $params{$_->[1]} = $_;
+	$_->[0] and $params .= $_->[0];
+	$_->[1] eq $name and $nb = $_->[2]
+    }
+    if ($params !~ /h/ && ! defined $params{help}) {
+	$params .= 'h';
+	my $h = [ "h", "help", -1, "<path> <to> <the> <function>", "Display help, eg. $name -h option_X suboption_Y.", 
+	    sub { 
+		my (@path) = @_; 
+		my $p = $par;
+		foreach my $f (@path) {
+		    foreach my $e (@$par) {
+			if ($e->[1] eq $f) {
+			    if (ref $e->[2]) {
+				$p = $e->[2];
+			    } else {
+				last
+			    }
+			}
+		    }
+		}
+		usage($name, $p, 0, $noexit)
+	    }, "Calling help" ];
+	$params{help} = $h;
+	$params{h} = $h;
+	push @$par, $h
+    }
+
+    my (@default, @todo);
+    if (@$args) {
+	my ($onlyarg, $a);
+	local $_;
+	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 (/^--(.+)/ && $params{$1}) { 
+		push @cur, $1 
+	    } elsif (/^--$/) { 
+		$onlyarg = 1 
+	    } elsif (/^-\S+$/) { 
+		push @default, $_;
+		$onlyarg = 1 
+	    } else { push @default, $_ } 
+	    foreach my $s (@cur) {
+		$params{$s} or usage($name, $par, "$s, not such option", $noexit);
+		my $tmp = getArgs($name, $s, $args, \%params, $par, $noexit);
+		push @todo, [ $params{$s}[5], $tmp, $params{$s}[6] ]
+	    }
+	}
+    } elsif ($nb) {
+	usage($name, $par,1, $noexit);
+    }
+    my $tmp = getArgs($name,$name, \@default, \%params, $par, $noexit);
+    unshift @todo, [$params{$name}[5], $tmp, $params{$name}[6]];
+    push @$args, @default;
+    return \@todo
+}
+
+sub getArgs {
+    my ($name, $s, $args, $params, $par, $noexit) = @_;
+    my $i = $params->{$s}[2]; 
+    my $tmp = [];
+    my $a;
+    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", $noexit);
+		$a =~ /^-./ and usage($name,$par, "$s before $a, not enough argument", $noexit); 
+		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", $noexit);  
+		$a =~ /^-./ and usage($name,$par, "$s, before $a, not enough argument", $noexit); 
+		push @$tmp, $a; 
+		$a = 0 
+	    }
+	}
+    }
+    return $tmp;
+}
+
+sub usage {
+    my ($name, $par, $level, $noexit) = @_;
+    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() unless $noexit
+}
+
+1