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 (\&mro::get_linear_isa) {
  20         $impl = \&mro::get_linear_isa;
  21     } else {
  22         my $loaded = do {
  23             local $SIG{__DIE__} = 'DEFAULT';
  24             eval "use 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     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     my $max = scalar(@_);
  61     for (my $i = 0; $i < $max ; $i++) {
  62         if ($i + 1 < $max && ref($_[$i + 1])) {
  63             push @roles, [ $_[$i++] => $_[$i] ];
  64         } else {
  65             push @roles, [ $_[$i] => {} ];
  66         }
  67     }
  68
  69     foreach my $role_spec (@roles) {
  70         Mouse::load_class( $role_spec->[0] );
  71     }
  72
  73     ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
  74         || croak("You can only consume roles, "
  75         . $_->[0]
  76         . " is not a Moose role")
  77         foreach @roles;
  78
  79     if ( scalar @roles == 1 ) {
  80         my ( $role, $params ) = @{ $roles[0] };
  81         $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
  82     }
  83     else {
  84         Mouse::Meta::Role->combine_apply($meta, @roles);
  85     }
  86
  87 }
  88
  89 1;
  90
  91 __END__
  92
  93 =head1 NAME
  94
  95 Mouse::Util - features, with or without their dependencies
  96
  97 =head1 IMPLEMENTATIONS FOR
  98
  99 =head2 L<MRO::Compat>
 100
 101 =head3 get_linear_isa
 102
 103 =head2 L<Scalar::Util>
 104
 105 =head3 blessed
 106
 107 =head3 looks_like_number
 108
 109 =head3 reftype
 110
 111 =head3 openhandle
 112
 113 =head3 weaken
 114
 115 C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
 116 without L<Scalar::Util>, an error is thrown.
 117
 118 =head2 Test::Exception
 119
 120 =head3 throws_ok
 121
 122 =head3 lives_ok
 123
 124 =cut
 125