summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNicolas Vigier <boklm@mageia.org>2011-02-15 16:50:35 +0000
committerNicolas Vigier <boklm@mageia.org>2011-02-15 16:50:35 +0000
commit4324211c234a647f3e82542a2dd54b748156620c (patch)
treed4421dfea4afab7768f111a4e38d51fbfd301b81
downloadmkcd-commandline-4324211c234a647f3e82542a2dd54b748156620c.tar
mkcd-commandline-4324211c234a647f3e82542a2dd54b748156620c.tar.gz
mkcd-commandline-4324211c234a647f3e82542a2dd54b748156620c.tar.bz2
mkcd-commandline-4324211c234a647f3e82542a2dd54b748156620c.tar.xz
mkcd-commandline-4324211c234a647f3e82542a2dd54b748156620c.zip
add Mkcd-Commandline1.1.0
-rw-r--r--Makefile10
-rw-r--r--Mkcd/Commandline.pm178
2 files changed, 188 insertions, 0 deletions
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..2c36997
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,10 @@
+NAME = Mkcd-Commandline
+
+VERSION = 1.1.0
+
+PERL_VENDORLIB=$(shell eval "`perl -V:installvendorlib`"; echo $$installvendorlib)
+
+install:
+ install -d $(DESTDIR)/$(PERL_VENDORLIB)/Mkcd
+ install Mkcd/Commandline.pm $(DESTDIR)/$(PERL_VENDORLIB)/Mkcd/
+
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