local-lib5/lib/perl5/MooseX/Declare/Context/WithOptions.pm

   1 package MooseX::Declare::Context::WithOptions;
   2
   3 use Moose::Role;
   4 use Carp qw/croak/;
   5 use MooseX::Types::Moose qw/HashRef/;
   6
   7 use namespace::clean -except => 'meta';
   8
   9 has options => (
  10     is      => 'rw',
  11     isa     => HashRef,
  12     default => sub { {} },
  13     lazy    => 1,
  14 );
  15
  16 sub strip_options {
  17     my ($self) = @_;
  18     my %ret;
  19
  20     # Make errors get reported from right place in source file
  21     local $Carp::Internal{'MooseX::Declare'} = 1;
  22     local $Carp::Internal{'Devel::Declare'} = 1;
  23
  24     $self->skipspace;
  25     my $linestr = $self->get_linestr;
  26
  27     while (substr($linestr, $self->offset, 1) !~ /[{;]/) {
  28         my $key = $self->strip_name;
  29         if (!defined $key) {
  30             croak 'expected option name'
  31               if keys %ret;
  32             return; # This is the case when { class => 'foo' } happens
  33         }
  34
  35         croak "unknown option name '$key'"
  36             unless $key =~ /^(extends|with|is)$/;
  37
  38         my $val = $self->strip_name;
  39         if (!defined $val) {
  40             if (defined($val = $self->strip_proto)) {
  41                 $val = [split /\s*,\s*/, $val];
  42             }
  43             else {
  44                 croak "expected option value after $key";
  45             }
  46         }
  47
  48         $ret{$key} ||= [];
  49         push @{ $ret{$key} }, ref $val ? @{ $val } : $val;
  50     } continue {
  51         $self->skipspace;
  52         $linestr = $self->get_linestr();
  53     }
  54
  55     my $options = { map {
  56         my $key = $_;
  57         $key eq 'is'
  58             ? ($key => { map { ($_ => 1) } @{ $ret{$key} } })
  59             : ($key => $ret{$key})
  60     } keys %ret };
  61
  62     $self->options($options);
  63
  64     return $options;
  65 }
  66
  67 1;