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; |
272a1930 |
7 | use Scalar::Util qw(blessed looks_like_number openhandle reftype weaken); |
4093c859 |
8 | |
eae80759 |
9 | our @EXPORT_OK = qw( |
272a1930 |
10 | blessed looks_like_number openhandle reftype weaken |
eae80759 |
11 | get_linear_isa |
eae80759 |
12 | ); |
13 | our %EXPORT_TAGS = ( |
14 | all => \@EXPORT_OK, |
15 | ); |
16 | |
42d7df00 |
17 | BEGIN { |
272a1930 |
18 | my $impl; |
19 | if (\&mro::get_linear_isa) { |
20 | $impl = \&mro::get_linear_isa; |
21 | } else { |
f172d4e7 |
22 | my $loaded = do { |
23 | local $SIG{__DIE__} = 'DEFAULT'; |
272a1930 |
24 | eval "use MRO::Compat (); 1"; |
f172d4e7 |
25 | }; |
272a1930 |
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; |
eae80759 |
50 | } |
51 | } |
272a1930 |
52 | no strict 'refs'; |
53 | *{ __PACKAGE__ . '::get_linear_isa'} = $impl; |
eae80759 |
54 | } |
55 | |
2e92bb89 |
56 | sub apply_all_roles { |
57 | my $meta = Mouse::Meta::Class->initialize(shift); |
2e92bb89 |
58 | |
21498b08 |
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 | |
2e92bb89 |
87 | } |
88 | |
4093c859 |
89 | 1; |
90 | |
f38ce2d0 |
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 | |
ea0b9e39 |
118 | =head2 Test::Exception |
119 | |
120 | =head3 throws_ok |
121 | |
122 | =head3 lives_ok |
123 | |
f38ce2d0 |
124 | =cut |
125 | |