source: soft/build_system/build_system/mkcd/branches/Corpo_2_1/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) 
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        while (@$args || $a) {
85            $_ = $a ? $a : shift @$args;
86            $a = 0;
87            my @cur;
88            if ($onlyarg) {
89                push @default, $_
90            } elsif ($params && /^-([$params]+)$/) {
91                my @letter = split / */, $1; 
92                push @cur, @letter;
93            } elsif (/^--(.+)/ && $params{$1}) { 
94                push @cur, $1 
95            } elsif (/^--$/) { 
96                $onlyarg = 1 
97            } else { push @default, $_ } 
98            foreach my $s (@cur) {
99                $params{$s} or usage($name,$par, "$s, not such option");
100                my $tmp = getArgs($name,$s,$args, \%params,$par);
101                push @todo, [$params{$s}[5], $tmp, $params{$s}[6]]
102            }
103        }
104    } elsif ($nb) {
105        usage($name,$par,1);
106    }
107    my $tmp = getArgs($name,$name, \@default, \%params,$par);
108    unshift @todo, [$params{$name}[5], $tmp, $params{$name}[6]];
109    push @$args, @default;
110    return \@todo
111}
112
113sub getArgs {
114    my ($name, $s, $args, $params, $par) = @_;
115    my $i = $params->{$s}[2]; 
116    my $tmp = [];
117    my $a;
118    if (ref $i) {
119        foreach my $f (@{parseCommandLine($params->{$s}[1],$args,$i)}) {
120            &{$f->[0]}($tmp, @{$f->[1]}) or print "ERROR getArgs: $f->[2]\n";
121        }
122    } else {
123        if ($i < 0) { 
124            while ($i++) { 
125                $a = shift @$args;
126                length $a or usage($name,$par, "$s not enough argument");
127                $a =~ /^-./ and usage($name,$par, "$s before $a, not enough argument"); 
128                push @$tmp, $a 
129            } 
130            while ($a = shift @$args) { 
131                if ($a =~ /^-./) { 
132                    unshift @$args, $a; 
133                    last 
134                } 
135                push @$tmp, $a;
136                $a = 0 
137            }
138        } else { 
139            while ($i--) { 
140                $a = shift @$args;
141                length $a or usage($name,$par, "$s, not enough argument"); 
142                $a =~ /^-./ and usage($name,$par, "$s, before $a, not enough argument"); 
143                push @$tmp, $a; 
144                $a = 0 
145            }
146        }
147    }
148    return $tmp;
149}
150
151sub usage {
152    my ($name, $par, $level) = @_;
153    my $st;
154    foreach (sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @$par) {
155        if ($_->[1] eq $name) { 
156            $st = "\nusage
157            $name $_->[3]
158            $_->[4]
159
160            options:
161
162$st"; 
163            next
164        }
165        $_->[0] and $st .= "\t\t-$_->[0], --$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
166        $_->[1] and $st .= "\t\t--$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
167    }
168
169    print "\nERROR $name: $level\n" if $level;
170    print "$st\n";
171    exit()
172}
173
1741
Note: See TracBrowser for help on using the repository browser.