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