lib/MooseX/Role/Parameterized.pm

   1 #!/usr/bin/env perl
   2 package MooseX::Role::Parameterized;
   3 use Moose qw/extends around confess/;
   4 use Moose::Role ();
   5 extends 'Moose::Exporter';
   6
   7 use MooseX::Role::Parameterized::Meta::Role::Parameterizable;
   8
   9 our $CURRENT_METACLASS;
  10
  11 __PACKAGE__->setup_import_methods(
  12     with_caller => ['parameter', 'role', 'has'],
  13 );
  14
  15 sub parameter {
  16     my $caller = shift;
  17     my $names  = shift;
  18
  19     $names = [$names] if !ref($names);
  20
  21     for my $name (@$names) {
  22         $caller->meta->add_parameter($name, @_);
  23     }
  24 }
  25
  26 sub role {
  27     my $caller         = shift;
  28     my $role_generator = shift;
  29     $caller->meta->role_generator($role_generator);
  30 }
  31
  32 sub init_meta {
  33     my $self = shift;
  34
  35     return Moose::Role->init_meta(@_,
  36         metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterizable',
  37     );
  38 }
  39
  40 # give role a (&) prototype
  41 around _make_wrapper => sub {
  42     my $orig = shift;
  43     my ($self, $caller, $sub, $fq_name) = @_;
  44
  45     if ($fq_name =~ /::role$/) {
  46         return sub (&) { $sub->($caller, @_) };
  47     }
  48
  49     return $orig->(@_);
  50 };
  51
  52 sub has {
  53     confess "has must be called within the role { ... } block."
  54         unless $CURRENT_METACLASS;
  55
  56     my $caller = shift;
  57     my $names  = shift;
  58
  59     $names = [$names] if !ref($names);
  60
  61     for my $name (@$names) {
  62         $CURRENT_METACLASS->add_attribute($name, @_);
  63     }
  64 }
  65
  66 1;
  67