source: soft/build_system/build_system/mkcd/tags/V3_8_3_1mdk/pm/Mkcd/Commandline.pm @ 1

Last change on this file since 1 was 1, checked in by fasma, 12 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733

File size: 4.0 KB
Line 
1package Mkcd::Commandline;
2
3our $VERSION = '1.1.0';
4
5use strict;
6require Exporter;
7our @ISA = qw(Exporter);
8our @EXPORT = qw(parseCommandLine usage);
9
10=head1 NAME
11
12commandline - mkcd module
13
14=head1 SYNOPSYS
15
16    require Mkcd::Commandline;
17
18=head1 DESCRIPTION
19
20C<Mkcd::Commandline> include the mkcd command line parsing functions.
21
22=head1 SEE ALSO
23
24mkcd
25
26=head1 COPYRIGHT
27
28Copyright (C) 2000,2001,2002 MandrakeSoft <warly@mandrakesoft.com>
29
30This program is free software; you can redistribute it and/or modify
31it under the terms of the GNU General Public License as published by
32the Free Software Foundation; either version 2, or (at your option)
33any later version.
34
35This program is distributed in the hope that it will be useful,
36but WITHOUT ANY WARRANTY; without even the implied warranty of
37MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
38GNU General Public License for more details.
39
40You should have received a copy of the GNU General Public License
41along with this program; if not, write to the Free Software
42Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
43
44=cut
45
46sub parseCommandLine {
47    my ($name, $args, $par) = @_;
48
49    my %params;
50    my ($params, $nb);
51    foreach (@$par) {
52        $_->[0] and $params{$_->[0]} = $_;
53        $_->[1] and $params{$_->[1]} = $_;
54        $_->[0] and $params .= $_->[0];
55        $_->[1] eq $name and $nb = $_->[2]
56    }
57    if ($params !~ /h/ && ! defined $params{help}) {
58        $params .= 'h';
59        my $h = [ "h", "help", -1, "<path> <to> <the> <function>", "Display help, eg. $name -h option_X suboption_Y.", 
60            sub { 
61                my (@path) = @_; 
62                my $p = $par;
63                foreach my $f (@path) {
64                    foreach my $e (@$par) {
65                        if ($e->[1] eq $f) {
66                            if (ref $e->[2]) {
67                                $p = $e->[2];
68                            } else {
69                                last
70                            }
71                        }
72                    }
73                }
74                usage($name, $p, 0)
75            }, "Calling help" ];
76        $params{help} = $h;
77        $params{h} = $h;
78        push @$par, $h
79    }
80
81    my (@default, @todo);
82    if (@$args) {
83        my ($onlyarg, $a);
84        local $_;
85        while (@$args || $a) {
86            $_ = $a ? $a : shift @$args;
87            $a = 0;
88            my @cur;
89            if ($onlyarg) {
90                push @default, $_
91            } elsif ($params && /^-([$params]+)$/) {
92                my @letter = split / */, $1; 
93                push @cur, @letter;
94            } elsif (/^--(.+)/ && $params{$1}) { 
95                push @cur, $1 
96            } elsif (/^--$/) { 
97                $onlyarg = 1 
98            } else { push @default, $_ } 
99            foreach my $s (@cur) {
100                $params{$s} or usage($name,$par, "$s, not such option");
101                my $tmp = getArgs($name,$s,$args, \%params,$par);
102                push @todo, [$params{$s}[5], $tmp, $params{$s}[6]]
103            }
104        }
105    } elsif ($nb) {
106        usage($name,$par,1);
107    }
108    my $tmp = getArgs($name,$name, \@default, \%params,$par);
109    unshift @todo, [$params{$name}[5], $tmp, $params{$name}[6]];
110    push @$args, @default;
111    return \@todo
112}
113
114sub getArgs {
115    my ($name, $s, $args, $params, $par) = @_;
116    my $i = $params->{$s}[2]; 
117    my $tmp = [];
118    my $a;
119    if (ref $i) {
120        foreach my $f (@{parseCommandLine($params->{$s}[1],$args,$i)}) {
121            &{$f->[0]}($tmp, @{$f->[1]}) or print "ERROR getArgs: $f->[2]\n";
122        }
123    } else {
124        if ($i < 0) { 
125            while ($i++) { 
126                $a = shift @$args;
127                length $a or usage($name,$par, "$s not enough argument");
128                $a =~ /^-./ and usage($name,$par, "$s before $a, not enough argument"); 
129                push @$tmp, $a 
130            } 
131            while ($a = shift @$args) { 
132                if ($a =~ /^-./) { 
133                    unshift @$args, $a; 
134                    last 
135                } 
136                push @$tmp, $a;
137                $a = 0 
138            }
139        } else { 
140            while ($i--) { 
141                $a = shift @$args;
142                length $a or usage($name,$par, "$s, not enough argument"); 
143                $a =~ /^-./ and usage($name,$par, "$s, before $a, not enough argument"); 
144                push @$tmp, $a; 
145                $a = 0 
146            }
147        }
148    }
149    return $tmp;
150}
151
152sub usage {
153    my ($name, $par, $level) = @_;
154    my $st;
155    foreach (sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @$par) {
156        if ($_->[1] eq $name) { 
157            $st = "\nusage
158            $name $_->[3]
159            $_->[4]
160
161            options:
162
163$st"; 
164            next
165        }
166        $_->[0] and $st .= "\t\t-$_->[0], --$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
167        $_->[1] and $st .= "\t\t--$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
168    }
169
170    print "\nERROR $name: $level\n" if $level;
171    print "$st\n";
172    exit()
173}
174
1751
Note: See TracBrowser for help on using the repository browser.