local-lib5/lib/perl5/MooseX/Declare/Syntax/KeywordHandling.pm

   1 package MooseX::Declare::Syntax::KeywordHandling;
   2
   3 use Moose::Role;
   4 use Moose::Util::TypeConstraints;
   5 use Devel::Declare ();
   6 use Sub::Install qw( install_sub );
   7 use Moose::Meta::Class ();
   8 use List::MoreUtils qw( uniq );
   9
  10 use aliased 'MooseX::Declare::Context';
  11
  12 use namespace::clean -except => 'meta';
  13
  14 requires qw(
  15     parse
  16 );
  17
  18 has identifier => (
  19     is          => 'ro',
  20     isa         => subtype(as 'Str', where { /^ [_a-z] [_a-z0-9]* $/ix }),
  21     required    => 1,
  22 );
  23
  24 sub get_identifier { shift->identifier }
  25
  26 sub context_class { Context }
  27
  28 sub context_traits { }
  29
  30 sub setup_for {
  31     my ($self, $setup_class, %args) = @_;
  32
  33     # make sure the stack is valid
  34     my $stack = $args{stack} || [];
  35     my $ident = $self->get_identifier;
  36
  37     # setup the D:D handler for our keyword
  38     Devel::Declare->setup_for($setup_class, {
  39         $ident => {
  40             const => sub { $self->parse_declaration((caller(1))[1], \%args, @_) },
  41         },
  42     });
  43
  44     # search or generate a real export
  45     my $export = $self->can('generate_export') ? $self->generate_export($setup_class) : sub { };
  46
  47     # export subroutine
  48     install_sub({
  49         code    => $export,
  50         into    => $setup_class,
  51         as      => $ident,
  52     }) unless $setup_class->can($ident);
  53
  54     return 1;
  55 }
  56
  57 sub parse_declaration {
  58     my ($self, $caller_file, $args, @ctx_args) = @_;
  59
  60     # find and load context object class
  61     my $ctx_class = $self->context_class;
  62     Class::MOP::load_class $ctx_class;
  63
  64     # do we have traits?
  65     if (my @ctx_traits = uniq $self->context_traits) {
  66
  67         Class::MOP::load_class $_
  68             for @ctx_traits;
  69
  70         $ctx_class = Moose::Meta::Class->create_anon_class(
  71             superclasses => [$ctx_class],
  72             roles        => [@ctx_traits],
  73             cache        => 1,
  74         )->name;
  75     }
  76
  77     # create a context object and initialize it
  78     my $ctx = $ctx_class->new(
  79         %{ $args },
  80         caller_file => $caller_file,
  81     );
  82     $ctx->init(@ctx_args);
  83
  84     # parse with current context
  85     return $self->parse($ctx);
  86 }
  87
  88 1;
  89
  90 __END__
  91
  92 =head1 NAME
  93
  94 MooseX::Declare::Syntax::KeywordHandling - Basic keyword functionality
  95
  96 =head1 DESCRIPTION
  97
  98 This role provides the functionality common for all keyword handlers
  99 in L<MooseX::Declare>.
 100
 101 =head1 ATTRIBUTES
 102
 103 =head2 identifier
 104
 105 This is the name of the actual keyword. It is a required string that is in
 106 the same format as a usual Perl identifier.
 107
 108 =head1 REQUIRED METHODS
 109
 110 =head2 parse
 111
 112   Object->parse (Object $context)
 113
 114 This method must implement the actual parsing of the keyword syntax.
 115
 116 =head1 METHODS
 117
 118 =head2 get_identifier
 119
 120   Str Object->get_identifier ()
 121
 122 Returns the name the handler will be setup under.
 123
 124 =head2 setup_for
 125
 126   Object->setup_for (ClassName $class, %args)
 127
 128 This will setup the handler in the specified C<$class>. The handler will
 129 dispatch to the L</parse_declaration> method when the keyword is used.
 130
 131 A normal code reference will also be exported into the calling namespace.
 132 It will either be empty or, if a C<generate_export> method is provided,
 133 the return value of that method.
 134
 135 =head2 parse_declaration
 136
 137   Object->parse_declaration (Str $filename, HashRef $setup_args, @call_args)
 138
 139 This simply creates a new L<context|MooseX::Declare::Context> and passes it
 140 to the L</parse> method.
 141
 142 =head1 SEE ALSO
 143
 144 =over
 145
 146 =item * L<MooseX::Declare>
 147
 148 =item * L<MooseX::Declare::Context>
 149
 150 =back
 151
 152 =head1 AUTHOR, COPYRIGHT & LICENSE
 153
 154 See L<MooseX::Declare>
 155
 156 =cut
 157