[Module-build-checkins] Module-Build/lib/Module/Build Base.pm,1.473,1.474
Status: Beta
Brought to you by:
kwilliams
|
From: Randy W. S. <si...@us...> - 2005-08-11 09:36:55
|
Update of /cvsroot/module-build/Module-Build/lib/Module/Build In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14997/lib/Module/Build Modified Files: Base.pm Log Message: Allow custom command line options to have dashes. Perform transformations on some builtin command line options so that dashes can be used in place of underscores. Allow boolean options to be used without arguments as a flag to set the option. Also, allow inverted option names to unset the option. Eg. --verbose, --noverbose, --no-verbose Index: Base.pm =================================================================== RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Base.pm,v retrieving revision 1.473 retrieving revision 1.474 diff -u -d -r1.473 -r1.474 --- Base.pm 11 Aug 2005 01:58:29 -0000 1.473 +++ Base.pm 11 Aug 2005 09:36:45 -0000 1.474 @@ -1270,9 +1270,41 @@ return $self->{args}{$key}; } +sub _translate_option { + my $self = shift; + my $opt = shift; + + (my $tr_opt = $opt) =~ tr/-/_/; + + return $tr_opt if grep $_ eq $tr_opt, qw( + install_path + html_css + meta_add + meta_merge + gen_manpages + gen_html + install_manpages + install_html + test_files + install_base + create_makefile_pl + create_readme + extra_compiler_flags + extra_linker_flags + ignore_prereq_conflicts + ignore_prereq_requires + ignore_prereqs + skip_rcfile + ); # normalize only selected option names + + return $opt; +} + sub _read_arg { my ($self, $args, $key, $val) = @_; + $key = $self->_translate_option($key); + if ( exists $args->{$key} ) { $args->{$key} = [ $args->{$key} ] unless ref $args->{$key}; push @{$args->{$key}}, $val; @@ -1281,21 +1313,64 @@ } } +sub _optional_arg { + my $self = shift; + my $opt = shift; + my $argv = shift; + + $opt = $self->_translate_option($opt); + + my @bool_opts = qw( + gen_manpages + gen_html + install_manpages + install_html + verbose + create_readme + pollute + quiet + ignore_prereq_conflicts + ignore_prereq_requires + ignore_prereqs + skip_rcfile + ); + + # inverted boolean options; eg --noverbose or --no-verbose + # converted to proper name & returned with false value (verbose, 0) + if ( grep $opt =~ /^no-?$_$/, @bool_opts ) { + $opt =~ s/^no-?//; + return ($opt, 0); + } + + # non-boolean option; return option unchanged along with its argument + return ($opt, shift(@$argv)) unless grep $_ eq $opt, @bool_opts; + + # we're punting a bit here, if an option appears followed by a digit + # we take the digit as the argument for the option. If there is + # nothing that looks like a digit, we pretent the option is a flag + # that is being set and has no argument. + my $arg = 1; + $arg = shift(@$argv) if @$argv && $argv->[0] =~ /^\d+$/; + + return ($opt, $arg); +} + sub read_args { my $self = shift; my ($action, @argv); (my $args, @_) = $self->cull_options(@_); my %args = %$args; + my $opt_re = qr/[\w\-]+/; + while (@_) { local $_ = shift; - if ( /^(\w+)=(.*)/ ) { - $self->_read_arg(\%args, $1, $2); - } elsif ( /^--(\w+)$/ ) { - $self->_read_arg(\%args, $1, shift()); - } elsif ( /^--(\w+)=(.*)$/ ) { + if ( /^(?:--)?($opt_re)=(.*)$/ ) { $self->_read_arg(\%args, $1, $2); - } elsif ( /^(\w+)$/ and !defined($action)) { + } elsif ( /^--($opt_re)$/ ) { + my($opt, $arg) = $self->_optional_arg($1, \@_); + $self->_read_arg(\%args, $opt, $arg); + } elsif ( /^($opt_re)$/ and !defined($action)) { $action = $1; } else { push @argv, $_; |