File Coverage

blib/lib/Class/MOP/Overload.pm
Criterion Covered Total %
statement 62 68 91.1
branch 14 22 63.6
condition 10 15 66.6
subroutine 27 27 100.0
pod 4 5 80.0
total 117 137 85.4


line stmt bran cond sub pod time code
1             package Class::MOP::Overload;
2             our $VERSION = '2.2205';
3              
4 450     450   3240 use strict;
  450         1003  
  450         13904  
5 450     450   2322 use warnings;
  450         1030  
  450         10602  
6              
7 450     450   2477 use overload ();
  450         1047  
  450         9910  
8 450     450   2451 use Scalar::Util qw( blessed weaken );
  450         1097  
  450         24206  
9 450     450   2982 use Try::Tiny;
  450         1057  
  450         26699  
10              
11 450     450   3249 use parent 'Class::MOP::Object';
  450         1133  
  450         2753  
12              
13             my %Operators = (
14             map { $_ => 1 }
15             grep { $_ ne 'fallback' }
16             map { split /\s+/ } values %overload::ops
17             );
18              
19             sub new {
20 23     23 1 140 my ( $class, %params ) = @_;
21              
22 23 50       101 unless ( defined $params{operator} ) {
23 0         0 $class->_throw_exception('OverloadRequiresAnOperator');
24             }
25 23 50       162 unless ( $Operators{ $params{operator} } ) {
26             $class->_throw_exception(
27             'InvalidOverloadOperator',
28             operator => $params{operator},
29 0         0 );
30             }
31              
32 23 50 66     96 unless ( defined $params{method_name} || $params{coderef} ) {
33             $class->_throw_exception(
34             'OverloadRequiresAMethodNameOrCoderef',
35             operator => $params{operator},
36 0         0 );
37             }
38              
39 23 100       80 if ( $params{coderef} ) {
40 5 50 33     53 unless ( defined $params{coderef_package}
41             && defined $params{coderef_name} ) {
42              
43 0         0 $class->_throw_exception('OverloadRequiresNamesForCoderef');
44             }
45             }
46              
47 23 50 66     105 if ( $params{method}
48 15     15   627 && !try { $params{method}->isa('Class::MOP::Method') } ) {
49              
50 0         0 $class->_throw_exception('OverloadRequiresAMetaMethod');
51             }
52              
53 23 50 66     581 if ( $params{associated_metaclass}
54 21     21   640 && !try { $params{associated_metaclass}->isa('Class::MOP::Module') } )
55             {
56              
57 0         0 $class->_throw_exception('OverloadRequiresAMetaClass');
58             }
59              
60             my @optional_attrs
61 23         489 = qw( method_name coderef coderef_package coderef_name method associated_metaclass );
62              
63             return bless {
64             operator => $params{operator},
65 23 100       72 map { defined $params{$_} ? ( $_ => $params{$_} ) : () }
  138         574  
66             @optional_attrs
67             },
68             $class;
69             }
70              
71 51     51   4189 sub operator { $_[0]->{operator} }
72              
73 36     36   130 sub method_name { $_[0]->{method_name} }
74 3     3   20 sub has_method_name { exists $_[0]->{method_name} }
75              
76 2     2   12 sub method { $_[0]->{method} }
77 3     3   18 sub has_method { exists $_[0]->{method} }
78              
79 17     17   61 sub coderef { $_[0]->{coderef} }
80 46     46   214 sub has_coderef { exists $_[0]->{coderef} }
81              
82 2     2   13 sub coderef_package { $_[0]->{coderef_package} }
83 2     2   11 sub has_coderef_package { exists $_[0]->{coderef_package} }
84              
85 4     4   28 sub coderef_name { $_[0]->{coderef_name} }
86 2     2   13 sub has_coderef_name { exists $_[0]->{coderef_name} }
87              
88 6     6   35 sub associated_metaclass { $_[0]->{associated_metaclass} }
89              
90             sub is_anonymous {
91 4     4 1 12 my $self = shift;
92 4   100     12 return $self->has_coderef && $self->coderef_name eq '__ANON__';
93             }
94              
95             sub attach_to_class {
96 18     18 0 62 my ( $self, $class ) = @_;
97 18         46 $self->{associated_metaclass} = $class;
98 18         69 weaken $self->{associated_metaclass};
99             }
100              
101             sub clone {
102 16     16 1 39 my $self = shift;
103              
104 16         39 my $clone = bless { %{$self}, @_ }, blessed($self);
  16         162  
105 16 50       124 weaken $clone->{associated_metaclass} if $clone->{associated_metaclass};
106              
107 16         61 $clone->_set_original_overload($self);
108              
109 16         162 return $clone;
110             }
111              
112 1     1 1 8 sub original_overload { $_[0]->{original_overload} }
113 16     16   41 sub _set_original_overload { $_[0]->{original_overload} = $_[1] }
114              
115             sub _is_equal_to {
116 15     15   38 my $self = shift;
117 15         24 my $other = shift;
118              
119 15 100       33 if ( $self->has_coderef ) {
120 7 50       21 return unless $other->has_coderef;
121 7         22 return $self->coderef == $other->coderef;
122             }
123             else {
124 8         25 return $self->method_name eq $other->method_name;
125             }
126             }
127              
128             1;
129              
130             # ABSTRACT: Overload Meta Object
131              
132             __END__
133              
134             =pod
135              
136             =encoding UTF-8
137              
138             =head1 NAME
139              
140             Class::MOP::Overload - Overload Meta Object
141              
142             =head1 VERSION
143              
144             version 2.2205
145              
146             =head1 SYNOPSIS
147              
148             my $meta = Class->meta;
149             my $overload = $meta->get_overloaded_operator('+');
150              
151             if ( $overload->has_method_name ) {
152             print 'Method for + is ', $overload->method_name, "\n";
153             }
154             else {
155             print 'Overloading for + is implemented by ',
156             $overload->coderef_name, " sub\n";
157             }
158              
159             =head1 DESCRIPTION
160              
161             This class provides meta information for overloading in classes and roles.
162              
163             =head1 INHERITANCE
164              
165             C<Class::MOP::Overload> is a subclass of L<Class::MOP::Object>.
166              
167             =head1 METHODS
168              
169             =head2 Class::MOP::Overload->new(%options)
170              
171             This method creates a new C<Class::MOP::Overload> object. It accepts a number
172             of options:
173              
174             =over 4
175              
176             =item * operator
177              
178             This is a string that matches an operator known by the L<overload> module,
179             such as C<""> or C<+>. This is required.
180              
181             =item * method_name
182              
183             The name of the method which implements the overloading. Note that this does
184             not need to actually correspond to a real method, since it's okay to declare a
185             not-yet-implemented overloading.
186              
187             Either this or the C<coderef> option must be passed.
188              
189             =item * method
190              
191             A L<Class::MOP::Method> object for the method which implements the
192             overloading.
193              
194             This is optional.
195              
196             =item * coderef
197              
198             A coderef which implements the overloading.
199              
200             Either this or the C<method_name> option must be passed.
201              
202             =item * coderef_package
203              
204             The package where the coderef was defined.
205              
206             This is required if C<coderef> is passed.
207              
208             =item * coderef_name
209              
210             The name of the coderef. This can be "__ANON__".
211              
212             This is required if C<coderef> is passed.
213              
214             =item * associated_metaclass
215              
216             A L<Class::MOP::Module> object for the associated class or role.
217              
218             This is optional.
219              
220             =back
221              
222             =head2 $overload->operator
223              
224             Returns the operator for this overload object.
225              
226             =head2 $overload->method_name
227              
228             Returns the method name that implements overloading, if it has one.
229              
230             =head2 $overload->has_method_name
231              
232             Returns true if the object has a method name.
233              
234             =head2 $overload->method
235              
236             Returns the L<Class::MOP::Method> that implements overloading, if it has one.
237              
238             =head2 $overload->has_method
239              
240             Returns true if the object has a method.
241              
242             =head2 $overload->coderef
243              
244             Returns the coderef that implements overloading, if it has one.
245              
246             =head2 $overload->has_coderef
247              
248             Returns true if the object has a coderef.
249              
250             =head2 $overload->coderef_package
251              
252             Returns the package for the coderef that implements overloading, if it has
253             one.
254              
255             =head2 $overload->has_coderef
256              
257             Returns true if the object has a coderef package.
258              
259             =head2 $overload->coderef_name
260              
261             Returns the sub name for the coderef that implements overloading, if it has
262             one.
263              
264             =head2 $overload->has_coderef_name
265              
266             Returns true if the object has a coderef name.
267              
268             =head2 $overload->is_anonymous
269              
270             Returns true if the overloading is implemented by an anonymous coderef.
271              
272             =head2 $overload->associated_metaclass
273              
274             Returns the L<Class::MOP::Module> (class or role) that is associated with the
275             overload object.
276              
277             =head2 $overload->clone
278              
279             Clones the overloading object, setting C<original_overload> in the process.
280              
281             =head2 $overload->original_overload
282              
283             For cloned objects, this returns the L<Class::MOP::Overload> object from which
284             they were cloned. This can be used to determine the source of an overloading
285             in a class that came from a role, for example.
286              
287             =head1 AUTHORS
288              
289             =over 4
290              
291             =item *
292              
293             Stevan Little <stevan@cpan.org>
294              
295             =item *
296              
297             Dave Rolsky <autarch@urth.org>
298              
299             =item *
300              
301             Jesse Luehrs <doy@cpan.org>
302              
303             =item *
304              
305             Shawn M Moore <sartak@cpan.org>
306              
307             =item *
308              
309             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
310              
311             =item *
312              
313             Karen Etheridge <ether@cpan.org>
314              
315             =item *
316              
317             Florian Ragwitz <rafl@debian.org>
318              
319             =item *
320              
321             Hans Dieter Pearcey <hdp@cpan.org>
322              
323             =item *
324              
325             Chris Prather <chris@prather.org>
326              
327             =item *
328              
329             Matt S Trout <mstrout@cpan.org>
330              
331             =back
332              
333             =head1 COPYRIGHT AND LICENSE
334              
335             This software is copyright (c) 2006 by Infinity Interactive, Inc.
336              
337             This is free software; you can redistribute it and/or modify it under
338             the same terms as the Perl 5 programming language system itself.
339              
340             =cut