File Coverage

blib/lib/Exporter/Declare/Export.pm
Criterion Covered Total %
statement 38 38 100.0
branch 6 8 75.0
condition 1 3 33.3
subroutine 12 12 100.0
pod 4 4 100.0
total 61 65 93.8


line stmt bran cond sub pod time code
1             package Exporter::Declare::Export;
2 11     11   547 use strict;
  11         13  
  11         343  
3 11     11   516 use warnings;
  11         14  
  11         319  
4 11     11   50 use Carp qw/croak carp/;
  11         13  
  11         646  
5 11     11   58 use Scalar::Util qw/reftype/;
  11         13  
  11         2999  
6              
7             our %OBJECT_DATA;
8              
9 130     130 1 184 sub required_specs {qw/ exported_by /}
10              
11             sub new {
12 130     130 1 5209 my $class = shift;
13 130         261 my ( $item, %specs ) = @_;
14 130         263 my $self = bless( $item, $class );
15              
16 130         248 for my $prop ( $self->required_specs ) {
17 136 100       370 croak "You must specify $prop when calling $class\->new()"
18             unless $specs{$prop};
19             }
20              
21 128         1078 $OBJECT_DATA{$self} = \%specs;
22              
23 128         269 return $self;
24             }
25              
26             sub _data {
27 32     32   27 my $self = shift;
28 32 50       52 ($OBJECT_DATA{$self}) = @_ if @_;
29 32         111 $OBJECT_DATA{$self};
30             }
31              
32             sub exported_by {
33 10     10 1 394 shift->_data->{ exported_by };
34             }
35              
36             sub inject {
37 86     86 1 71 my $self = shift;
38 86         98 my ( $class, $name, @args ) = @_;
39              
40 86 100       172 carp(
41             "Ignoring arguments importing ("
42             . reftype($self)
43             . ")$name into $class: "
44             . join( ', ', @args )
45             ) if (@args);
46              
47 86 50 33     714 croak "You must provide a class and name to inject()"
48             unless $class && $name;
49 11     11   55 no strict 'refs';
  11         20  
  11         300  
50 11     11   52 no warnings 'once';
  11         15  
  11         1035  
51 86         69 *{"$class\::$name"} = $self;
  86         426  
52             }
53              
54             sub DESTROY {
55 5     5   5094 my $self = shift;
56 5         35 delete $OBJECT_DATA{$self};
57             }
58              
59             1;
60              
61             =head1 NAME
62              
63             Exporter::Declare::Export - Base class for all export objects.
64              
65             =head1 DESCRIPTION
66              
67             All exports are refs, and all are blessed. This class tracks some per-export
68             information via an inside-out objects system. All things an export may need to
69             do, such as inject itself into a package are handled here. This allows some
70             complicated, or ugly logic to be abstracted out of the exporter and metadata
71             classes.
72              
73             =head1 METHODS
74              
75             =over
76              
77             =item $class->new( $ref, exported_by => $package, %data )
78              
79             Create a new export from $ref. You must specify the name of the class doing the
80             exporting.
81              
82             =item $export->inject( $package, $name, @args )
83              
84             This will inject the export into $package under $name. @args are ignored in
85             most cases. See L for an example where
86             they are used.
87              
88             =item $package = $export->exported_by()
89              
90             Returns the name of the package from which this export was originally exported.
91              
92             =item @params = $export->required_specs()
93              
94             Documented for subclassing purposes. This should always return a list of
95             required parameters at construction time.
96              
97             =item $export->DESTROY()
98              
99             Documented for subclassing purposes. This takes care of cleanup related to
100             storing data in an inside-out objects system.
101              
102             =back
103              
104             =head1 AUTHORS
105              
106             Chad Granum L
107              
108             =head1 COPYRIGHT
109              
110             Copyright (C) 2010 Chad Granum
111              
112             Exporter-Declare is free software; Standard perl licence.
113              
114             Exporter-Declare is distributed in the hope that it will be useful, but
115             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
116             FITNESS FOR A PARTICULAR PURPOSE. See the license for more details.