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; |
bcd39bf4 |
19 | if ($] >= 5.009_005) { |
272a1930 |
20 | $impl = \&mro::get_linear_isa; |
21 | } else { |
f172d4e7 |
22 | my $loaded = do { |
23 | local $SIG{__DIE__} = 'DEFAULT'; |
bcd39bf4 |
24 | eval "require 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 | } |
bcd39bf4 |
52 | |
272a1930 |
53 | no strict 'refs'; |
54 | *{ __PACKAGE__ . '::get_linear_isa'} = $impl; |
eae80759 |
55 | } |
56 | |
2e92bb89 |
57 | sub apply_all_roles { |
58 | my $meta = Mouse::Meta::Class->initialize(shift); |
2e92bb89 |
59 | |
21498b08 |
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 | |
2e92bb89 |
88 | } |
89 | |
4093c859 |
90 | 1; |
91 | |
f38ce2d0 |
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 | |
ea0b9e39 |
119 | =head2 Test::Exception |
120 | |
121 | =head3 throws_ok |
122 | |
123 | =head3 lives_ok |
124 | |
f38ce2d0 |
125 | =cut |
126 | |