File Coverage

blib/lib/Aspect/Modular.pm
Criterion Covered Total %
statement 24 28 85.7
branch 4 6 66.6
condition 0 3 0.0
subroutine 6 7 85.7
pod 0 3 0.0
total 34 47 72.3


line stmt bran cond sub pod time code
1             package Aspect::Modular;
2              
3 4     4   22 use strict;
  4         7  
  4         117  
4 4     4   1460 use Aspect::Library ();
  4         10  
  4         1514  
5              
6             our $VERSION = '1.04';
7             our @ISA = 'Aspect::Library';
8              
9             sub new {
10 7     7 0 16 my $class = shift;
11 7         35 my $self = bless { @_ }, $class;
12              
13             # Generate the appropriate advice
14 7         39 $self->{advice} = [
15             $self->get_advice( $self->args )
16             ];
17              
18             # Warn if the aspect is supposed to be permanent,
19             # but the advice isn't created as permanent.
20 7 100       94 if ( $self->lexical ) {
21 3 50       7 if ( grep { not $_->lexical } @{$self->{advice}} ) {
  3         42  
  3         13  
22 0         0 warn("$class creates lexical advice for global aspects");
23             }
24             } else {
25 4 50       9 if ( grep { $_->lexical } @{$self->{advice}} ) {
  4         43  
  4         17  
26 0         0 warn("$class creates global advice for lexical aspects");
27             }
28             }
29              
30 7         94 return $self;
31             }
32              
33             sub args {
34 7     7 0 11 @{$_[0]->{args}};
  7         58  
35             }
36              
37             sub lexical {
38             $_[0]->{lexical};
39             }
40              
41             sub get_advice {
42 0   0 0 0   my $class = ref $_[0] || $_[0];
43 0           die("Method 'get_advice' is not implemented by class '$class'");
44             }
45              
46              
47              
48              
49              
50             ######################################################################
51             # Optional XS Acceleration
52              
53             BEGIN {
54 4     4   9 local $@;
55 4     4   379 eval <<'END_PERL';
  4         25  
  4         121  
  4         46  
56             use Class::XSAccessor 1.08 {
57             replace => 1,
58             getters => {
59             'lexical' => 'lexical',
60             },
61             };
62             END_PERL
63             }
64              
65             1;
66              
67             __END__