Commit | Line | Data |
4093c859 |
1 | #!/usr/bin/env perl |
2 | package Mouse::Util; |
3 | use strict; |
4 | use warnings; |
5c12655d |
5 | use base qw/Exporter/; |
d72006ca |
6 | use Carp; |
4093c859 |
7 | |
eae80759 |
8 | our @EXPORT_OK = qw( |
eae80759 |
9 | get_linear_isa |
eae80759 |
10 | ); |
11 | our %EXPORT_TAGS = ( |
12 | all => \@EXPORT_OK, |
13 | ); |
14 | |
42d7df00 |
15 | BEGIN { |
272a1930 |
16 | my $impl; |
bcd39bf4 |
17 | if ($] >= 5.009_005) { |
272a1930 |
18 | $impl = \&mro::get_linear_isa; |
19 | } else { |
f172d4e7 |
20 | my $loaded = do { |
21 | local $SIG{__DIE__} = 'DEFAULT'; |
bcd39bf4 |
22 | eval "require MRO::Compat; 1"; |
f172d4e7 |
23 | }; |
272a1930 |
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; |
eae80759 |
48 | } |
49 | } |
bcd39bf4 |
50 | |
272a1930 |
51 | no strict 'refs'; |
52 | *{ __PACKAGE__ . '::get_linear_isa'} = $impl; |
eae80759 |
53 | } |
54 | |
2e92bb89 |
55 | sub apply_all_roles { |
56 | my $meta = Mouse::Meta::Class->initialize(shift); |
2e92bb89 |
57 | |
21498b08 |
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 | |
2e92bb89 |
86 | } |
87 | |
4093c859 |
88 | 1; |
89 | |
f38ce2d0 |
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 | |
f38ce2d0 |
102 | =cut |
103 | |