Show
Ignore:
Timestamp:
01/06/09 13:49:59 (5 years ago)
Author:
masaki
Message:

add OptionTypeMap?

Location:
lang/perl/MouseX-Getopt/trunk
Files:
2 added
3 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/MouseX-Getopt/trunk

    • Property svn:ignore set to
      Makefile
      Makefile.old
      blib
      inc
      pm_to_blib
      META.yml
      MANIFEST.bak
  • lang/perl/MouseX-Getopt/trunk/MANIFEST

    r27960 r27994  
    5959inc/Test/More.pm 
    6060lib/MouseX/Getopt.pm 
     61lib/MouseX/Getopt/OptionTypeMap.pm 
    6162Makefile.PL 
    6263MANIFEST                        This list of files 
  • lang/perl/MouseX-Getopt/trunk/lib/MouseX/Getopt.pm

    r27960 r27994  
    33use 5.8.1; 
    44use Mouse::Role; 
     5use MouseX::Getopt::OptionTypeMap; 
    56use Getopt::Long (); 
    67 
     
    1011    my ($class, %params) = @_; 
    1112 
     13    my %processed = $class->_parse_argv( 
     14        specs  => $class->_attrs_to_specs, 
     15        params => \%params, 
     16    ); 
     17 
    1218    return $class->new( 
    13         %params, # explicit params to new 
    14         $class->_parse_argv(%params), #" params from CLI 
     19        %params,    # explicit params to new 
     20        %processed, # params from CLI 
    1521    ); 
    1622} 
     
    1925    my ($class, %params) = @_; 
    2026 
    21     my $options  = $class->_attrs_to_options; 
    22     my %init_arg = map { $_->{name} => $_->{init_arg} } @$options; 
     27    local @ARGV = @{ $params{argv} || \@ARGV }; 
     28    my $specs = $params{specs}; 
    2329 
    24     local @ARGV = @{ $params{argv} || \@ARGV }; 
    25  
    26     my @err; 
    27     my $parsed_options = eval { 
    28         local $SIG{__WARN__} = sub { push @err, @_ }; 
    29         Getopt::Long::GetOptions(\my %options, map { $_->{spec} } @$options); 
     30    my @warn; 
     31    my $options = eval { 
     32        local $SIG{__WARN__} = sub { push @warn, @_ }; 
     33        Getopt::Long::GetOptions(\my %options, map { $_->{spec} } values %$specs); 
    3034        \%options; 
    3135    }; 
    32     if (@err or $@) { 
    33         die join '', grep { defined } @err, $@; 
     36    if (@warn or $@) { 
     37        die join '', grep { defined } @warn, $@; 
    3438    } 
    3539 
    36     my %args = map { $init_arg{$_} => $parsed_options->{$_} } keys %$parsed_options; 
     40    my %args = map { $specs->{$_}->{name} => $options->{$_} } keys %$options; 
    3741    return %args; 
    3842} 
    3943 
    40 sub _attrs_to_options { 
     44sub _attrs_to_specs { 
    4145    my $class = shift; 
    4246 
    43     my @options; 
     47    my $specs = {}; 
    4448    for my $attr ($class->meta->compute_all_applicable_attributes) { 
    4549        my $name = $attr->name; 
     
    4953        if ($attr->has_type_constraint) { 
    5054            my $type = $attr->type_constraint; 
    51             if ($class->_has_option_type($type)) { 
    52                 $spec .= $class->_get_option_type($type); 
     55            if (MouseX::Getopt::OptionTypeMap->has_option_type($type)) { 
     56                $spec .= MouseX::Getopt::OptionTypeMap->get_option_type($type); 
    5357            } 
    5458        } 
    5559 
    5660        $name =~ s/\W/_/g; 
    57         push @options, { 
    58             name     => $name, 
    59             spec     => $spec, 
    60             init_arg => $attr->init_arg, 
    61         }; 
     61        $specs->{$name} = { spec => $spec, name => $attr->init_arg }; 
    6262    } 
    6363 
    64     \@options; 
    65 } 
    66  
    67 { 
    68     my %typemap = ( 
    69         'Bool'     => '!', 
    70         'Str'      => '=s', 
    71         'Int'      => '=i', 
    72         'Num'      => '=f', 
    73         'ArrayRef' => '=s@', 
    74         'HashRef'  => '=s%', 
    75     ); 
    76  
    77     sub _has_option_type { exists $typemap{$_[1]} } 
    78     sub _get_option_type { $typemap{$_[1]} } 
     64    $specs; 
    7965} 
    8066