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 use Scalar::Util qw(blessed looks_like_number openhandle reftype weaken);
   8
   9 our @EXPORT_OK = qw(
  10     blessed looks_like_number openhandle reftype weaken
  11     get_linear_isa
  12 );
  13 our %EXPORT_TAGS = (
  14     all  => \@EXPORT_OK,
  15 );
  16
  17 BEGIN {
  18     my $impl;
  19     if ($] >= 5.009_005) {
  20         $impl = \&mro::get_linear_isa;
  21     } else {
  22         my $loaded = do {
  23             local $SIG{__DIE__} = 'DEFAULT';
  24             eval "require MRO::Compat; 1";
  25         };
  26         if ($loaded) {
  27             $impl = \&mro::get_linear_isa;
  28         } else {
  29 #       VVVVV   CODE TAKEN FROM MRO::COMPAT   VVVVV
  30             my $code; # this recurses so it isn't pretty
  31             $code = sub {
  32                 no strict 'refs';
  33
  34                 my $classname = shift;
  35
  36                 my @lin = ($classname);
  37                 my %stored;
  38                 foreach my $parent (@{"$classname\::ISA"}) {
  39                     my $plin = $code->($parent);
  40                     foreach (@$plin) {
  41                         next if exists $stored{$_};
  42                         push(@lin, $_);
  43                         $stored{$_} = 1;
  44                     }
  45                 }
  46                 return \@lin;
  47             };
  48 #       ^^^^^   CODE TAKEN FROM MRO::COMPAT   ^^^^^
  49             $impl = $code;
  50         }
  51     }
  52
  53     no strict 'refs';
  54     *{ __PACKAGE__ . '::get_linear_isa'} = $impl;
  55 }
  56
  57 sub apply_all_roles {
  58     my $meta = Mouse::Meta::Class->initialize(shift);
  59
  60     my @roles;
  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 =head2 L<Scalar::Util>
 105
 106 =head3 blessed
 107
 108 =head3 looks_like_number
 109
 110 =head3 reftype
 111
 112 =head3 openhandle
 113
 114 =head3 weaken
 115
 116 C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
 117 without L<Scalar::Util>, an error is thrown.
 118
 119 =head2 Test::Exception
 120
 121 =head3 throws_ok
 122
 123 =head3 lives_ok
 124
 125 =cut
 126