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