t/lib/MooseCompat.pm

   1 package MooseCompat;
   2 # Moose compatible methods/functions
   3
   4 package Mouse::Meta::Module;
   5
   6 sub version   { no strict 'refs'; ${shift->name.'::VERSION'}   }
   7 sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} }
   8 sub identifier {
   9     my $self = shift;
  10     return join '-' => (
  11        $self->name,
  12         ($self->version   || ()),
  13         ($self->authority || ()),
  14     );
  15 }
  16
  17 package Mouse::Meta::Role;
  18
  19 for my $modifier_type (qw/before after around/) {
  20     my $modifier = "${modifier_type}_method_modifiers";
  21     my $has_method_modifiers = sub{
  22         my($self, $method_name) = @_;
  23         my $m = $self->{$modifier}->{$method_name};
  24         return $m && @{$m} != 0;
  25     };
  26
  27     no strict 'refs';
  28     *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers;
  29 }
  30
  31
  32 sub has_override_method_modifier {
  33     my ($self, $method_name) = @_;
  34     return exists $self->{override_method_modifiers}->{$method_name};
  35 }
  36
  37 sub get_method_modifier_list {
  38     my($self, $modifier_type) = @_;
  39
  40     return keys %{ $self->{$modifier_type . '_method_modifiers'} };
  41 }
  42
  43 package Mouse::Util::TypeConstraints;
  44
  45 use Mouse::Util::TypeConstraints ();
  46
  47 sub export_type_constraints_as_functions { # TEST ONLY
  48     my $into = caller;
  49
  50     foreach my $type( list_all_type_constraints() ) {
  51         my $tc = find_type_constraint($type)->_compiled_type_constraint;
  52         my $as = $into . '::' . $type;
  53
  54         no strict 'refs';
  55         *{$as} = sub{ &{$tc} || undef };
  56     }
  57     return;
  58 }
  59
  60 package
  61     Mouse::Meta::Attribute;
  62
  63 sub applied_traits{            $_[0]->{traits} } # TEST ONLY
  64 sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
  65
  66 1;