File Coverage

blib/lib/Moose/Meta/Role/Application/ToInstance.pm
Criterion Covered Total %
statement 33 33 100.0
branch 5 6 83.3
condition 2 2 100.0
subroutine 10 10 100.0
pod 1 1 100.0
total 51 52 98.0


line stmt bran cond sub pod time code
1             package Moose::Meta::Role::Application::ToInstance;
2             our $VERSION = '2.2206';
3              
4 377     377   3165 use strict;
  377         1145  
  377         12062  
5 377     377   2346 use warnings;
  377         1152  
  377         10175  
6 377     377   2413 use metaclass;
  377         1261  
  377         2566  
7              
8 377     377   3221 use Scalar::Util 'blessed';
  377         1311  
  377         24832  
9 377     377   2963 use List::Util 1.33 'all';
  377         9220  
  377         27289  
10 377     377   3430 use Devel::OverloadInfo 0.004 'is_overloaded';
  377         8677  
  377         21015  
11              
12 377     377   2833 use parent 'Moose::Meta::Role::Application';
  377         1206  
  377         3039  
13              
14             __PACKAGE__->meta->add_attribute('rebless_params' => (
15             reader => 'rebless_params',
16             default => sub { {} },
17             Class::MOP::_definition_context(),
18             ));
19              
20 377     377   50863 use constant _NEED_OVERLOAD_HACK_FOR_OBJECTS => "$]" < 5.008009;
  377         1131  
  377         113521  
21              
22             sub apply {
23 23     23 1 93 my ( $self, $role, $object, $args ) = @_;
24              
25 23   100     83 my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class';
26              
27             # This is a special case to handle the case where the object's metaclass
28             # is a Class::MOP::Class, but _not_ a Moose::Meta::Class (for example,
29             # when applying a role to a Moose::Meta::Attribute object).
30 23 50       151 $obj_meta = 'Moose::Meta::Class'
31             unless $obj_meta->isa('Moose::Meta::Class');
32              
33             my $class = $obj_meta->create_anon_class(
34             superclasses => [ blessed($object) ],
35             roles => [ $role, keys(%$args) ? ($args) : () ],
36 23 100   3   376 cache => (all { $_ eq '-alias' || $_ eq '-excludes' } keys %$args),
  3 100       29  
37             );
38              
39 23         132 $class->rebless_instance( $object, %{ $self->rebless_params } );
  23         891  
40              
41 23         46 if ( _NEED_OVERLOAD_HACK_FOR_OBJECTS
42             && is_overloaded( ref $object ) ) {
43              
44             # need to use $_[2] here to apply to the object in the caller
45             _reset_amagic($_[2]);
46             }
47              
48 23         93 return $object;
49             }
50              
51             1;
52              
53             # ABSTRACT: Compose a role into an instance
54              
55             __END__
56              
57             =pod
58              
59             =encoding UTF-8
60              
61             =head1 NAME
62              
63             Moose::Meta::Role::Application::ToInstance - Compose a role into an instance
64              
65             =head1 VERSION
66              
67             version 2.2206
68              
69             =head1 DESCRIPTION
70              
71             =head2 METHODS
72              
73             =over 4
74              
75             =item B<new>
76              
77             =item B<meta>
78              
79             =item B<apply>
80              
81             =item B<rebless_params>
82              
83             =back
84              
85             =head1 BUGS
86              
87             See L<Moose/BUGS> for details on reporting bugs.
88              
89             =head1 AUTHORS
90              
91             =over 4
92              
93             =item *
94              
95             Stevan Little <stevan@cpan.org>
96              
97             =item *
98              
99             Dave Rolsky <autarch@urth.org>
100              
101             =item *
102              
103             Jesse Luehrs <doy@cpan.org>
104              
105             =item *
106              
107             Shawn M Moore <sartak@cpan.org>
108              
109             =item *
110              
111             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
112              
113             =item *
114              
115             Karen Etheridge <ether@cpan.org>
116              
117             =item *
118              
119             Florian Ragwitz <rafl@debian.org>
120              
121             =item *
122              
123             Hans Dieter Pearcey <hdp@cpan.org>
124              
125             =item *
126              
127             Chris Prather <chris@prather.org>
128              
129             =item *
130              
131             Matt S Trout <mstrout@cpan.org>
132              
133             =back
134              
135             =head1 COPYRIGHT AND LICENSE
136              
137             This software is copyright (c) 2006 by Infinity Interactive, Inc.
138              
139             This is free software; you can redistribute it and/or modify it under
140             the same terms as the Perl 5 programming language system itself.
141              
142             =cut