From: Yuval Kogman Date: Wed, 4 Jul 2007 23:24:55 +0000 (+0000) Subject: Refactor MooseX::Getopt into smaller methods X-Git-Tag: 0_06~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee211848ee47820075d174225f566dbb38517657;p=gitmo%2FMooseX-Getopt.git Refactor MooseX::Getopt into smaller methods --- diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index b9a5a1d..c773e22 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -16,7 +16,55 @@ has extra_argv => (is => 'rw', isa => 'ArrayRef'); sub new_with_options { my ($class, %params) = @_; - my (@options, %name_to_init_arg); + my %processed = $class->_parse_argv( options => [ $class->_attrs_to_options( %params ) ] ); + + $class->new( + ARGV => $processed{argv_copy}, + extra_argv => $processed{argv}, + %params, # explicit params to ->new + %{ $processed{params} }, # params from CLI + ); +} + +sub _parse_argv { + my ( $class, %params ) = @_; + + local @ARGV = @{ $params{argv} || \@ARGV }; + + my ( @options, %name_to_init_arg, %options ); + + foreach my $opt ( @{ $params{options} } ) { + push @options, $opt->{opt_string}; + $name_to_init_arg{ $opt->{name} } = $opt->{init_arg}; + } + + # Get a clean copy of the original @ARGV + my $argv_copy = [ @ARGV ]; + + { + local $SIG{__WARN__} = sub { die $_[0] }; + Getopt::Long::GetOptions(\%options, @options); + } + + # Get a copy of the Getopt::Long-mangled @ARGV + my $argv_mangled = [ @ARGV ]; + + return ( + argv_copy => $argv_copy, + argv => $argv_mangled, + params => { + map { + $name_to_init_arg{$_} => $options{$_} + } keys %options, + } + ); +} + +sub _attrs_to_options { + my $class = shift; + + my @options; + foreach my $attr ($class->meta->compute_all_applicable_attributes) { my $name = $attr->name; @@ -29,9 +77,7 @@ sub new_with_options { else { next if $name =~ /^_/; } - - $name_to_init_arg{$name} = $attr->init_arg; - + my $opt_string = $aliases ? join(q{|}, $name, @$aliases) : $name; @@ -42,39 +88,17 @@ sub new_with_options { $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name); } } - - push @options => $opt_string; - } - - my %options; - # Get a clean copy of the original @ARGV - my $argv_copy = [ @ARGV ]; - - { - local $SIG{__WARN__} = sub { die $_[0] }; - Getopt::Long::GetOptions(\%options, @options); + push @options, { + name => $name, + init_arg => $attr->init_arg, + opt_string => $opt_string, + required => $attr->is_required, + ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ), + } } - # Get a copy of the Getopt::Long-mangled @ARGV - my $argv_mangled = [ @ARGV ]; - - # Restore the original @ARGV; - @ARGV = @$argv_copy; - - #use Data::Dumper; - #warn Dumper \@options; - #warn Dumper \%name_to_init_arg; - #warn Dumper \%options; - - $class->new( - ARGV => $argv_copy, - extra_argv => $argv_mangled, - %params, - map { - $name_to_init_arg{$_} => $options{$_} - } keys %options, - ); + return @options; } no Moose::Role; 1;