diff options
Diffstat (limited to 'Mkcd')
| -rw-r--r-- | Mkcd/Commandline.pm | 178 |
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 |