lib/Mouse/Util.pm

   1 package Mouse::Util;
   2 use strict;
   3 use warnings;
   4 use base qw/Exporter/;
   5 use Carp;
   6
   7 our @EXPORT_OK = qw(
   8     get_linear_isa
   9     apply_all_roles
  10 );
  11 our %EXPORT_TAGS = (
  12     all  => \@EXPORT_OK,
  13 );
  14
  15 BEGIN {
  16     my $impl;
  17     if ($] >= 5.009_005) {
  18         require mro;
  19         $impl = \&mro::get_linear_isa;
  20     } else {
  21         my $loaded = do {
  22             local $SIG{__DIE__} = 'DEFAULT';
  23             eval "require MRO::Compat; 1";
  24         };
  25         if ($loaded) {
  26             $impl = \&mro::get_linear_isa;
  27         } else {
  28 #       VVVVV   CODE TAKEN FROM MRO::COMPAT   VVVVV
  29             my $code; # this recurses so it isn't pretty
  30             $code = sub {
  31                 no strict 'refs';
  32
  33                 my $classname = shift;
  34
  35                 my @lin = ($classname);
  36                 my %stored;
  37                 foreach my $parent (@{"$classname\::ISA"}) {
  38                     my $plin = $code->($parent);
  39                     foreach (@$plin) {
  40                         next if exists $stored{$_};
  41                         push(@lin, $_);
  42                         $stored{$_} = 1;
  43                     }
  44                 }
  45                 return \@lin;
  46             };
  47 #       ^^^^^   CODE TAKEN FROM MRO::COMPAT   ^^^^^
  48             $impl = $code;
  49         }
  50     }
  51
  52     no strict 'refs';
  53     *{ __PACKAGE__ . '::get_linear_isa'} = $impl;
  54 }
  55
  56 sub apply_all_roles {
  57     my $meta = Mouse::Meta::Class->initialize(shift);
  58
  59     my @roles;
  60
  61     # Basis of Data::OptList
  62     my $max = scalar(@_);
  63     for (my $i = 0; $i < $max ; $i++) {
  64         if ($i + 1 < $max && ref($_[$i + 1])) {
  65             push @roles, [ $_[$i++] => $_[$i] ];
  66         } else {
  67             push @roles, [ $_[$i] => {} ];
  68         }
  69     }
  70
  71     foreach my $role_spec (@roles) {
  72         Mouse::load_class( $role_spec->[0] );
  73     }
  74
  75     ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
  76         || croak("You can only consume roles, "
  77         . $_->[0]
  78         . " is not a Moose role")
  79         foreach @roles;
  80
  81     if ( scalar @roles == 1 ) {
  82         my ( $role, $params ) = @{ $roles[0] };
  83         $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
  84     }
  85     else {
  86         Mouse::Meta::Role->combine_apply($meta, @roles);
  87     }
  88
  89 }
  90
  91 1;
  92
  93 __END__
  94
  95 =head1 NAME
  96
  97 Mouse::Util - features, with or without their dependencies
  98
  99 =head1 IMPLEMENTATIONS FOR
 100
 101 =head2 L<MRO::Compat>
 102
 103 =head3 get_linear_isa
 104
 105 =cut
 106