File Coverage

blib/lib/Exporter/Declare/Export/Generator.pm
Criterion Covered Total %
statement 31 33 93.9
branch 4 6 66.6
condition n/a
subroutine 10 10 100.0
pod 5 5 100.0
total 50 54 92.5


line stmt bran cond sub pod time code
1             package Exporter::Declare::Export::Generator;
2 5     5   2297 use strict;
  5         5  
  5         153  
3 5     5   20 use warnings;
  5         6  
  5         130  
4              
5 5     5   21 use base 'Exporter::Declare::Export::Sub';
  5         7  
  5         848  
6 5     5   380 use Exporter::Declare::Export::Variable;
  5         7  
  5         86  
7 5     5   18 use Carp qw/croak/;
  5         7  
  5         1356  
8              
9             sub required_specs {
10 6     6 1 5 my $self = shift;
11             return(
12 6         24 $self->SUPER::required_specs(),
13             qw/ type /,
14             );
15             }
16              
17 13     13 1 439 sub type { shift->_data->{ type }}
18              
19             sub new {
20 6     6 1 3403 my $class = shift;
21 6 50       22 croak "Generators must be coderefs, not " . ref($_[0])
22             unless ref( $_[0] ) eq 'CODE';
23 6         50 $class->SUPER::new( @_ );
24             }
25              
26             sub generate {
27 9     9 1 8 my $self = shift;
28 9         9 my ( $import_class, @args ) = @_;
29 9         29 my $ref = $self->( $self->exported_by, $import_class, @args );
30              
31 6         11 return Exporter::Declare::Export::Sub->new(
32             $ref,
33 9 100       44 %{ $self->_data },
34             ) if $self->type eq 'sub';
35              
36 3         5 return Exporter::Declare::Export::Variable->new(
37             $ref,
38 3 50       5 %{ $self->_data },
39             ) if $self->type eq 'variable';
40              
41 0         0 return $self->type->new(
42             $ref,
43 0         0 %{ $self->_data },
44             );
45             }
46              
47             sub inject {
48 9     9 1 22 my $self = shift;
49 9         11 my ( $class, $name, @args ) = @_;
50 9         13 $self->generate( $class, @args )->inject( $class, $name );
51             }
52              
53             1;
54              
55             =head1 NAME
56              
57             Exporter::Declare::Export::Generator - Export class for exports that should be
58             generated when imported.
59              
60             =head1 DESCRIPTION
61              
62             Export class for exports that should be generated when imported.
63              
64             =head1 OVERRIDEN METHODS
65              
66             =over 4
67              
68             =item $class->new( $ref, $ref, exported_by => $package, type => $type, %data )
69              
70             You must specify the type as 'sub' or 'variable'.
71              
72             =item $export->inject( $package, $name, @args )
73              
74             Calls generate() with @args to create a generated export. The new export is
75             then injected.
76              
77             =back
78              
79             =head1 ADDITIONAL METHODS
80              
81             =over 4
82              
83             =item $new = $export->generate( $import_class, @args )
84              
85             Generates a new export object.
86              
87             =item $type = $export->type()
88              
89             Returns the type of object to be generated (sub or variable)
90              
91             =back
92              
93             =head1 AUTHORS
94              
95             Chad Granum L
96              
97             =head1 COPYRIGHT
98              
99             Copyright (C) 2010 Chad Granum
100              
101             Exporter-Declare is free software; Standard perl licence.
102              
103             Exporter-Declare is distributed in the hope that it will be useful, but
104             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
105             FITNESS FOR A PARTICULAR PURPOSE. See the license for more details.