lib/Mouse/Util.pm

   1 #!/usr/bin/env perl
   2 package Mouse::Util;
   3 use strict;
   4 use warnings;
   5 use base qw/Exporter/;
   6 use Carp;
   7
   8 our @EXPORT_OK = qw(
   9     get_linear_isa
  10 );
  11 our %EXPORT_TAGS = (
  12     all  => \@EXPORT_OK,
  13 );
  14
  15 BEGIN {
  16     my $impl;
  17     if ($] >= 5.009_005) {
  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     my $max = scalar(@_);
  60     for (my $i = 0; $i < $max ; $i++) {
  61         if ($i + 1 < $max && ref($_[$i + 1])) {
  62             push @roles, [ $_[$i++] => $_[$i] ];
  63         } else {
  64             push @roles, [ $_[$i] => {} ];
  65         }
  66     }
  67
  68     foreach my $role_spec (@roles) {
  69         Mouse::load_class( $role_spec->[0] );
  70     }
  71
  72     ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
  73         || croak("You can only consume roles, "
  74         . $_->[0]
  75         . " is not a Moose role")
  76         foreach @roles;
  77
  78     if ( scalar @roles == 1 ) {
  79         my ( $role, $params ) = @{ $roles[0] };
  80         $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
  81     }
  82     else {
  83         Mouse::Meta::Role->combine_apply($meta, @roles);
  84     }
  85
  86 }
  87
  88 1;
  89
  90 __END__
  91
  92 =head1 NAME
  93
  94 Mouse::Util - features, with or without their dependencies
  95
  96 =head1 IMPLEMENTATIONS FOR
  97
  98 =head2 L<MRO::Compat>
  99
 100 =head3 get_linear_isa
 101
 102 =cut
 103