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