X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt.pm;h=98a72212ce3ab53342b4ce05f9d3062054af112c;hb=41d0ab091f0df3e2c1eae2401545c07c3798f76f;hp=ddbba8cc3352d339cb15d15ff8a40c6ead197d55;hpb=6c329add9865bff293ea15cb1ce1c3478bb50d4d;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index ddbba8c..98a7221 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -107,7 +107,11 @@ sub _traditional_spec { foreach my $opt ( @{ $params{options} } ) { push @options, $opt->{opt_string}; - $name_to_init_arg{ $opt->{name} } = $opt->{init_arg}; + + my $identifier = $opt->{name}; + $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names + + $name_to_init_arg{$identifier} = $opt->{init_arg}; } return ( \@options, \%name_to_init_arg ); @@ -128,7 +132,10 @@ sub _gld_spec { }, ]; - $name_to_init_arg{ $opt->{name} } = $opt->{init_arg}; + my $identifier = $opt->{name}; + $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names + + $name_to_init_arg{$identifier} = $opt->{init_arg}; } return ( \@options, \%name_to_init_arg ); @@ -145,24 +152,30 @@ sub _compute_getopt_attrs { } $class->meta->compute_all_applicable_attributes } +sub _get_cmd_flags_for_attr { + my ( $class, $attr ) = @_; + + my $flag = $attr->name; + + my @aliases; + + if ($attr->isa('MooseX::Getopt::Meta::Attribute')) { + $flag = $attr->cmd_flag if $attr->has_cmd_flag; + @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases; + } + + return ( $flag, @aliases ); +} + sub _attrs_to_options { my $class = shift; my @options; foreach my $attr ($class->_compute_getopt_attrs) { - my $name = $attr->name; - - my $aliases; - - if ($attr->isa('MooseX::Getopt::Meta::Attribute')) { - $name = $attr->cmd_flag if $attr->has_cmd_flag; - $aliases = $attr->cmd_aliases if $attr->has_cmd_aliases; - } + my ( $flag, @aliases ) = $class->_get_cmd_flags_for_attr($attr); - my $opt_string = $aliases - ? join(q{|}, $name, @$aliases) - : $name; + my $opt_string = join(q{|}, $flag, @aliases); if ($attr->has_type_constraint) { my $type_name = $attr->type_constraint->name; @@ -172,7 +185,7 @@ sub _attrs_to_options { } push @options, { - name => $name, + name => $flag, init_arg => $attr->init_arg, opt_string => $opt_string, required => $attr->is_required && !$attr->has_default && !$attr->has_builder,