File Coverage

blib/lib/Class/MOP/Method/Generated.pm
Criterion Covered Total %
statement 30 30 100.0
branch 11 14 78.5
condition 4 6 66.6
subroutine 8 8 100.0
pod 0 1 0.0
total 53 59 89.8


line stmt bran cond sub pod time code
1             package Class::MOP::Method::Generated;
2             our $VERSION = '2.2203';
3              
4 462     462   188559 use strict;
  462         941  
  462         12028  
5 462     462   2113 use warnings;
  462         859  
  462         10146  
6              
7 462     462   186945 use Eval::Closure;
  462         634009  
  462         20880  
8              
9 462     462   2956 use parent 'Class::MOP::Method';
  462         891  
  462         2282  
10              
11             ## accessors
12              
13             sub new {
14 1     1 0 327 $_[0]->_throw_exception( CannotCallAnAbstractBaseMethod => package_name => __PACKAGE__ );
15             }
16              
17             sub _initialize_body {
18 1     1   70 $_[0]->_throw_exception( NoBodyToInitializeInAnAbstractBaseClass => package_name => __PACKAGE__ );
19             }
20              
21             sub _generate_description {
22 55011     55011   87717 my ( $self, $context ) = @_;
23 55011   66     242285 $context ||= $self->definition_context;
24              
25 55011         74654 my $desc = "generated method";
26 55011         67265 my $origin = "unknown origin";
27              
28 55011 100       99566 if (defined $context) {
29 54960 50       102781 if (defined $context->{description}) {
30 54960         80560 $desc = $context->{description};
31             }
32              
33 54960 100 66     119266 if (defined $context->{file} || defined $context->{line}) {
34             $origin = "defined at "
35             . (defined $context->{file}
36             ? $context->{file} : "<unknown file>")
37             . " line "
38             . (defined $context->{line}
39 54070 50       193291 ? $context->{line} : "<unknown line>");
    50          
40             }
41             }
42              
43 55011         226246 return "$desc ($origin)";
44             }
45              
46             sub _compile_code {
47 55012     55012   108266 my ( $self, @args ) = @_;
48 55012 100       169323 unshift @args, 'source' if @args % 2;
49 55012         124878 my %args = @args;
50              
51 55012         93800 my $context = delete $args{context};
52 55012 100       205639 my $environment = $self->can('_eval_environment')
53             ? $self->_eval_environment
54             : {};
55              
56 55011         127371 return eval_closure(
57             environment => $environment,
58             description => $self->_generate_description($context),
59             %args,
60             );
61             }
62              
63             1;
64              
65             # ABSTRACT: Abstract base class for generated methods
66              
67             __END__
68              
69             =pod
70              
71             =encoding UTF-8
72              
73             =head1 NAME
74              
75             Class::MOP::Method::Generated - Abstract base class for generated methods
76              
77             =head1 VERSION
78              
79             version 2.2203
80              
81             =head1 DESCRIPTION
82              
83             This is a C<Class::MOP::Method> subclass which is subclassed by
84             C<Class::MOP::Method::Accessor> and
85             C<Class::MOP::Method::Constructor>.
86              
87             It is not intended to be used directly.
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