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

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

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

File size: 3.3 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++) { $a = shift @$args or usage($name,$par,"$s not enough argument"); $a =~ /^-./ and usage($name,$par,"$s before $a, not enough argument"); push @$tmp, $a } 
105                        while ($a = shift @$args) { if ($a =~ /^-./) { unshift @$args, $a ;last}; push @$tmp, $a ; $a = 0}
106                } else { 
107                        while ($i--) { $a = shift @$args or usage($name,$par,"$s, not enough argument");  $a =~ /^-./ and usage($name,$par,"$s, before $a, not enough argument"); push @$tmp, $a; $a = 0 }
108                }
109        }
110        return $tmp;
111}
112
113sub usage{
114        my ($name, $par, $level) = @_;
115        my $st;
116        foreach (@$par) {
117                if ($_->[1] eq $name) { 
118                    $st = "\nusage
119                $name $_->[3]
120                        $_->[4]
121
122        options:
123   
124$st"; 
125                    next
126                }
127                $_->[0] and $st .= "\t\t-$_->[0], --$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
128                $_->[1] and $st .= "\t\t--$_->[1] $_->[3]\n\t\t\t$_->[4]\n" and next;
129        }
130       
131        print "\nERROR $name: $level\n" if $level;
132        print "$st\n";
133        exit
134}
135
1361
Note: See TracBrowser for help on using the repository browser.