options.pm 9.09 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
16
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17 18
#

19 20 21 22 23 24 25 26
package options;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;

@ISA = qw(Exporter);
27
@EXPORT = qw();
28
@EXPORT_OK = qw($options parse_comma_list parse_value);
29

30
use vars qw($options);
31

Patrik Stridvall's avatar
Patrik Stridvall committed
32 33
use output qw($output);

34
sub parse_comma_list($$) {
35 36
    my $prefix = shift;
    my $value = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
37

38 39 40 41 42 43 44 45 46 47 48 49 50
    if(defined($prefix) && $prefix eq "no") {
	return { active => 0, filter => 0, hash => {} };
    } elsif(defined($value)) {
	my %names;
	for my $name (split /,/, $value) {
	    $names{$name} = 1;
	}
	return { active => 1, filter => 1, hash => \%names };
    } else {
	return { active => 1, filter => 0, hash => {} };
    }
}

51
sub parse_value($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
52 53 54 55 56 57
    my $prefix = shift;
    my $value = shift;

    return $value;
}

58 59 60 61
package _options;

use strict;

62 63
use output qw($output);

64 65 66
sub options_set($$);

sub new($$$$) {
67 68 69 70 71
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

72 73 74
    my $options_long = \%{$self->{_OPTIONS_LONG}};
    my $options_short = \%{$self->{_OPTIONS_SHORT}};
    my $options_usage = \${$self->{_OPTIONS_USAGE}};
75 76 77 78 79 80 81 82 83 84

    my $refoptions_long = shift;
    my $refoptions_short = shift;
    $$options_usage = shift;

    %$options_long = %{$refoptions_long};
    %$options_short = %{$refoptions_short};

    $self->options_set("default");

85
    my $arguments = \@{$self->{_ARGUMENTS}};
86
    @$arguments = ();
87

88
    my $end_of_options = 0;
89
    while(defined($_ = shift @ARGV)) {
90 91 92 93 94 95
	if(/^--$/) {
	    $end_of_options = 1;
	    next;
	} elsif($end_of_options) {
	    # Nothing
	} elsif(/^--(all|none)$/) {
96 97 98 99 100 101 102 103 104 105 106
	    $self->options_set("$1");
	    next;
	} elsif(/^-([^=]*)(=(.*))?$/) {
	    my $name;
	    my $value;
	    if(defined($2)) {
		$name = $1;
		$value = $3;
            } else {
		$name = $1;
	    }
107

108 109 110 111 112
	    if($name =~ /^([^-].*)$/) {
		$name = $$options_short{$1};
	    } else {
		$name =~ s/^-(.*)$/$1/;
	    }
113

114 115 116 117 118
	    my $prefix;
	    if(defined($name) && $name =~ /^no-(.*)$/) {
		$name = $1;
		$prefix = "no";
		if(defined($value)) {
119
		    $output->write("options with prefix 'no' can't take parameters\n");
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134

		    return undef;
		}
	    }

	    my $option;
	    if(defined($name)) {
		$option = $$options_long{$name};
	    }

	    if(defined($option)) {
		my $key = $$option{key};
		my $parser = $$option{parser};
		my $refvalue = \${$self->{$key}};
		my @parents = ();
135

136 137 138 139 140 141 142 143
		if(defined($$option{parent})) {
		    if(ref($$option{parent}) eq "ARRAY") {
			@parents = @{$$option{parent}};
		    } else {
			@parents = $$option{parent};
		    }
		}

144
		if(defined($parser)) {
145 146 147
		    if(!defined($value)) {
			$value = shift @ARGV;
		    }
148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
		    $$refvalue = &$parser($prefix,$value);
		} else {
		    if(defined($value)) {
			$$refvalue = $value;
		    } elsif(!defined($prefix)) {
			$$refvalue = 1;
		    } else {
			$$refvalue = 0;
		    }
		}

		if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
		    while($#parents >= 0) {
			my @old_parents = @parents;
			@parents = ();
			foreach my $parent (@old_parents) {
			    my $parentkey = $$options_long{$parent}{key};
			    my $refparentvalue = \${$self->{$parentkey}};
166

167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
			    $$refparentvalue = 1;

			    if(defined($$options_long{$parent}{parent})) {
				if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
				    push @parents, @{$$options_long{$parent}{parent}};
				} else {
				    push @parents, $$options_long{$parent}{parent};
				}
			    }
			}
		    }
		}
		next;
	    }
	}
182

183
	if(!$end_of_options && /^-(.*)$/) {
184
	    $output->write("unknown option: $_\n");
185
	    $output->write($$options_usage);
186 187
	    exit 1;
	} else {
188
	    push @$arguments, $_;
189 190 191 192
	}
    }

    if($self->help) {
193
	$output->write($$options_usage);
194 195 196 197
	$self->show_help;
	exit 0;
    }

198 199 200 201 202 203
    return $self;
}

sub DESTROY {
}

204
sub parse_files($) {
205 206 207
    my $self = shift;

    my $arguments = \@{$self->{_ARGUMENTS}};
Patrik Stridvall's avatar
Patrik Stridvall committed
208
    my $directories = \@{$self->{_DIRECTORIES}};
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225
    my $c_files = \@{$self->{_C_FILES}};
    my $h_files = \@{$self->{_H_FILES}};

    my $error = 0;
    my @files = ();
    foreach (@$arguments) {
	if(!-e $_) {
	    $output->write("$_: no such file or directory\n");
	    $error = 1;
	} else {
	    push @files, $_;
	}
    }
    if($error) {
	exit 1;
    }

226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
    my @paths = ();
    my @c_files = ();
    my @h_files = ();
    foreach my $file (@files) {
	if($file =~ /\.c$/) {
	    push @c_files, $file;
	} elsif($file =~ /\.h$/) {
	    push @h_files, $file;
	} else {
	    push @paths, $file;
	}
    }

    if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
    {
        @paths = ".";
    }

    if($#paths != -1 || $#c_files != -1) {
	my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
	my %found;
	@$c_files = sort(map {
	    s/^\.\/(.*)$/$1/;
249
	    if(defined($found{$_})) {
250 251 252 253 254 255 256 257
		();
	    } else {
		$found{$_}++;
		$_;
	    }
	} split(/\n/, `$c_command`));
    }

258 259
    if($#paths != -1 || $#h_files != -1) {
	my $h_command = "find " . join(" ", @paths, @h_files) . " -name \\*.h";
260 261 262 263 264 265 266 267 268 269 270 271
	my %found;

	@$h_files = sort(map {
	    s/^\.\/(.*)$/$1/;
	    if(defined($found{$_})) {
		();
	    } else {
		$found{$_}++;
		$_;
	    }
	} split(/\n/, `$h_command`));
    }
Patrik Stridvall's avatar
Patrik Stridvall committed
272 273 274 275 276 277 278 279 280 281

    my %dirs;
    foreach my $file (@$c_files, @$h_files) {
	my $dir = $file;
	$dir =~ s%/?[^/]+$%%;
	if(!$dir) { $dir = "."; }
	$dirs{$dir}++
    }

    @$directories = sort(keys(%dirs));
282 283
}

284
sub options_set($$) {
285 286
    my $self = shift;

287 288
    my $options_long = \%{$self->{_OPTIONS_LONG}};
    my $options_short = \%{$self->{_OPTIONS_SHORT}};
289 290 291 292 293 294 295 296 297 298 299 300

    local $_ = shift;
    for my $name (sort(keys(%$options_long))) {
        my $option = $$options_long{$name};
	my $key = uc($name);
	$key =~ tr/-/_/;
	$$option{key} = $key;
	my $refvalue = \${$self->{$key}};

	if(/^default$/) {
	    $$refvalue = $$option{default};
	} elsif(/^all$/) {
Patrik Stridvall's avatar
Patrik Stridvall committed
301
	    if($name !~ /^(?:help|debug|verbose|module)$/) {
302 303 304 305 306 307 308
		if(ref($$refvalue) ne "HASH") {
		    $$refvalue = 1;
		} else {
		    $$refvalue = { active => 1, filter => 0, hash => {} };
		}
	    }
	} elsif(/^none$/) {
Patrik Stridvall's avatar
Patrik Stridvall committed
309
	    if($name !~ /^(?:help|debug|verbose|module)$/) {
310 311 312 313 314 315 316 317 318 319
		if(ref($$refvalue) ne "HASH") {
		    $$refvalue = 0;
		} else {
		    $$refvalue = { active => 0, filter => 0, hash => {} };
		}
	    }
	}
    }
}

320
sub show_help($) {
321 322
    my $self = shift;

323 324
    my $options_long = \%{$self->{_OPTIONS_LONG}};
    my $options_short = \%{$self->{_OPTIONS_SHORT}};
325 326 327 328 329 330 331 332 333 334 335

    my $maxname = 0;
    for my $name (sort(keys(%$options_long))) {
	if(length($name) > $maxname) {
	    $maxname = length($name);
	}
    }

    for my $name (sort(keys(%$options_long))) {
	my $option = $$options_long{$name};
        my $description = $$option{description};
336
	my $parser = $$option{parser};
337 338 339
	my $current = ${$self->{$$option{key}}};

	my $value = $current;
340

341
	my $command;
342
	if(!defined $parser) {
343 344 345 346 347 348
	    if($value) {
		$command = "--no-$name";
	    } else {
		$command = "--$name";
	    }
	} else {
349
	    if(ref($value) eq "HASH" && $value->{active}) {
350 351 352 353 354 355
		$command = "--[no-]$name\[=<value>]";
	    } else {
		$command = "--$name\[=<value>]";
	    }
	}

356
	$output->write($command);
357 358
	$output->write(" " x (($maxname - length($name) + 17) - (length($command) - length($name) + 1)));
	if(!defined $parser) {
359
	    if($value) {
360
		$output->write("Disable ");
361
	    } else {
362
		$output->write("Enable ");
363
	    }
364
	} else {
365 366 367 368 369 370 371 372
	    if(ref($value) eq "HASH")
            {
                if ($value->{active}) {
                    $output->write("(Disable) ");
                } else {
                    $output->write("Enable ");
                }
            }
373
	}
374
        $output->write("$description\n");
375 376 377 378 379 380 381 382 383 384 385
    }
}

sub AUTOLOAD {
    my $self = shift;

    my $name = $_options::AUTOLOAD;
    $name =~ s/^.*::(.[^:]*)$/\U$1/;

    my $refvalue = $self->{$name};
    if(!defined($refvalue)) {
386
	die "<internal>: options.pm: member $name does not exist\n";
387 388 389 390 391 392 393 394 395
    }

    if(ref($$refvalue) ne "HASH") {
	return $$refvalue;
    } else {
	return $$refvalue->{active};
    }
}

396
sub arguments($) {
397 398 399 400
    my $self = shift;

    my $arguments = \@{$self->{_ARGUMENTS}};

401
    return @$arguments;
402 403
}

404
sub c_files($) {
405
    my $self = shift;
406 407 408 409 410 411 412 413 414 415

    my $c_files = \@{$self->{_C_FILES}};

    if(!defined(@$c_files)) {
	$self->parse_files;
    }

    return @$c_files;
}

416
sub h_files($) {
417
    my $self = shift;
418 419

    my $h_files = \@{$self->{_H_FILES}};
420

421 422 423 424 425 426
    if(!defined(@$h_files)) {
	$self->parse_files;
    }

    return @$h_files;
}
427

428
sub directories($) {
429
    my $self = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
430 431 432 433 434 435 436 437 438 439

    my $directories = \@{$self->{_DIRECTORIES}};

    if(!defined(@$directories)) {
	$self->parse_files;
    }

    return @$directories;
}

440
1;