root/gsdl/trunk/perllib/parsargv.pm @ 17110

Revision 15894, 5.6 KB (checked in by mdewsnip, 11 years ago)

Added "use strict" to the files missing it.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1###########################################################################
2#
3# parseargv.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package parsargv;
27
28use strict;
29
30#
31# parse(ARGVREF, [SPEC, VARREF] ...)
32#
33# Parse command line arguments.
34#
35# ARGVREF is an array reference, usually to @ARGV.  The remaining
36# arguments are paired (SPEC, VARREF).  SPEC is a specification string
37# for a particular argument; VARREF is a variable reference that will
38# receive the argument.
39#
40# SPEC is in one of the following forms:
41#
42# ARG/REGEX/DEFAULT ARG is the name of command line argument.  REGEX is
43#     a regular expression that gives legal values for the argument.
44#     DEFAULT is the default value assigned to VARREF if the option does
45#     not appear on the command line.  Example
46#
47#
48# ARG/REGEX ARG and REGEX are as above.  Since no default is given, ARG
49#     must appear on the command line; if it doesn't, parse() returns 0.
50#
51# ARG ARG is as above.  ARG is a boolean option.  VARREF is assigned 0 if ARG
52#     is not on the command line; 1 otherwise.
53#
54# SPEC may start with a punctuation character, in which case this
55# character will be used instead of '/' as a delimiter.  Useful when '/'
56# is needed in the REGEX part.
57#
58# VARREF is a reference to a scalar or an array.  If VARREF is an array
59# reference, then multiple command line options are allowed an append.  Example:
60#
61#   Command line: -day mon -day fri
62#
63#   parse(\@ARGV, "day/(mon|tue|wed|thu|fri)", \@days)
64#
65#   days => ('mon', 'fri')
66#
67# Returns 0 if there was an error, nonzero otherwise.
68#
69
70 
71sub parse
72{
73    my $arglist = shift;
74    my ($spec, $var);
75    my %option;
76
77    my @rest = @_;
78
79
80    # if the last argument is the string "allow_extra_options" then options
81    # in \@rest without a corresponding SPEC will be ignored (i.e. the "$arg is
82    # not a valid option" error won't occur)\n";
83    my $allow_extra_options = pop @rest;
84    if (defined ($allow_extra_options)) {
85    if ($allow_extra_options eq "allow_extra_options") {
86        $allow_extra_options = 1;
87    } else {
88        # put it back where we got it
89        push (@rest, $allow_extra_options);
90        $allow_extra_options = 0;
91    }
92    } else {
93    $allow_extra_options = 0;
94    }
95
96    while (($spec, $var) = splice(@rest, 0, 2))
97        {
98     
99    die "Variable for $spec is not a valid type."
100        unless ref($var) eq 'SCALAR' || ref($var) eq 'ARRAY'
101        || (ref($var) eq 'REF' && ref($$var) eq 'GLOB');
102
103    my $delimiter;
104    if ($spec !~ /^\w/)
105    {
106        $delimiter = substr($spec, 0, 1);
107        $spec = substr($spec, 1);
108    }
109    else
110    {
111        $delimiter = '/';
112    }
113    my ($name, $regex, $default) = split(/$delimiter/, $spec, 3);
114   
115   
116    if ($name)
117    {   
118        if ($default && $default !~ /$regex/)
119        {
120        die "Default value for $name doesn't match regex ($spec).";
121        }
122        $option{$name} = {'name' => $name,
123                  'regex' => $regex,
124                  'default' => $default,
125                  'varref' => $var,
126                  'set' => 0};
127    }
128    else
129    {
130        die "Invalid argument ($spec) for parsargv.";
131    }
132    }
133
134    my @argv;
135    my $arg;
136    my $parse_options = 1;
137    my $errors = 0;
138
139    while ($arg = shift(@$arglist))
140    {
141    if ($parse_options && $arg eq '--')
142    {
143        $parse_options = 0;
144        next;
145    }
146
147    if ($parse_options && $arg =~ /^-+\w/)
148    {
149        $arg =~ s/^-+//;
150
151        if (defined $option{$arg})
152        {
153        &process_arg($option{$arg}, $arglist, \$errors);
154        }
155        elsif (!$allow_extra_options)
156        {
157        print STDOUT "$arg is not a valid option.\n";
158        $errors++;
159        }
160    }
161    else
162    {
163        push(@argv, $arg);
164    }
165    }
166    @$arglist = @argv;
167
168    foreach $arg (keys %option)
169    {
170    if ($option{$arg}->{'set'} == 0)
171    {
172        if (defined $option{$arg}->{'default'})
173        {
174        &set_var($option{$arg}, $option{$arg}->{'default'});
175        }
176        elsif (!$option{$arg}->{'regex'})
177        {
178        &set_var($option{$arg}, 0)
179        }
180        elsif (ref($option{$arg}->{'varref'}) ne 'ARRAY')
181        {
182        print STDOUT "Missing command line argument -$arg.\n";
183        $errors++;
184        }
185    }
186    }
187    return $errors == 0;
188}
189
190sub process_arg
191{
192    my ($option, $arglist, $errors) = @_;
193
194    if ($option->{'regex'} && @$arglist > 0 && $arglist->[0] !~ /^-+\w/)
195    {
196    if ($arglist->[0] =~ /$option->{'regex'}/)
197    {
198        &set_var($option, shift(@$arglist));
199    }
200    else
201    {
202        print STDOUT  "Bad value for -$option->{'name'} argument.\n";
203        $$errors++;
204    }
205    }
206    elsif (!$option->{'regex'})
207    {
208    &set_var($option, 1);
209    }
210    else
211    {
212    print STDOUT "No value given for -$option->{'name'}.\n";
213    $$errors++;
214    }
215}
216
217sub set_var
218{
219    my ($option, $value) = @_;
220    my $type = ref($option->{'varref'});
221
222    if ($type eq 'SCALAR')
223    {
224    ${$option->{'varref'}} = $value;
225    }
226    elsif ($type eq 'ARRAY')
227    {
228    push(@{$option->{'varref'}}, $value);
229    }
230    $option->{'set'} = 1;
231}
232
2331;
234
235
236
237
238
239
240
241
Note: See TracBrowser for help on using the browser.