File Coverage

blib/lib/Test/Stream/Exporter/Meta.pm
Criterion Covered Total %
statement 44 44 100.0
branch 18 18 100.0
condition 4 6 66.6
subroutine 12 12 100.0
pod 6 7 85.7
total 84 87 96.5


line stmt bran cond sub pod time code
1             package Test::Stream::Exporter::Meta;
2 109     109   653 use strict;
  109         836  
  109         2397  
3 109     109   343 use warnings;
  109         102  
  109         2671  
4              
5             my %EXPORT_META;
6              
7 109     109   313 use Carp qw/croak confess/;
  109         103  
  109         28804  
8              
9             sub EXPORTS() { 'exports' }
10             sub PACKAGE() { 'package' }
11             sub DEFAULT() { 'default' }
12              
13 7146     7146 1 10878 sub exports { $_[0]->{+EXPORTS} }
14 846     846 1 2476 sub default { $_[0]->{+DEFAULT} }
15 1     1 0 7 sub package { $_[0]->{+PACKAGE} }
16              
17 8540     8540 1 27012 sub get { $EXPORT_META{$_[-1]} }
18              
19             sub new {
20 8828     8828 1 8453 my ($class, $pkg) = @_;
21              
22 8828 100       12819 confess "Package is required!"
23             unless $pkg;
24              
25 8827         8264 my $meta = $EXPORT_META{$pkg};
26 8827 100       20711 return $meta if $meta;
27              
28 1685         6094 $meta = bless({
29             EXPORTS() => {},
30             DEFAULT() => [],
31             PACKAGE() => $pkg,
32             }, $class);
33              
34 1685         13390 return $EXPORT_META{$pkg} = $meta;
35             }
36              
37             sub add {
38 1151     1151 1 1506 my ($self, $default, $name, $ref) = @_;
39              
40 1151 100       1901 confess "Name is mandatory" unless $name;
41              
42             confess "$name is already exported"
43 1150 100       2326 if $self->{+EXPORTS}->{$name};
44              
45 1149         1135 my $pkg = $self->{+PACKAGE};
46              
47 1149 100       1765 unless ($ref) {
48 109     109   460 no strict 'refs';
  109         154  
  109         15531  
49 3         3 $ref = *{"$pkg\::$name"}{CODE};
  3         18  
50             }
51              
52 1149 100 66     4182 confess "No reference or package sub found for '$name' in '$pkg'"
53             unless $ref && ref $ref;
54              
55             # Add the export ref
56 1148         1713 $self->{+EXPORTS}->{$name} = $ref;
57 1148 100       2626 push @{$self->{+DEFAULT}} => $name if $default;
  346         1195  
58             }
59              
60             sub add_bulk {
61 1861     1861 1 1867 my $self = shift;
62 1861         1590 my $default = shift;
63              
64 1861         2216 my $pkg = $self->{+PACKAGE};
65              
66 1861         2757 for my $name (@_) {
67             confess "$name is already exported"
68 11944 100       16072 if $self->{+EXPORTS}->{$name};
69              
70 109     109   419 no strict 'refs';
  109         136  
  109         9997  
71             $self->{+EXPORTS}->{$name} = *{"$pkg\::$name"}{CODE}
72 11943   66     6973 || confess "No reference or package sub found for '$name' in '$pkg'";
73             }
74              
75 1859 100       4259 push @{$self->{+DEFAULT}} => @_ if $default;
  826         3104  
76             }
77              
78             1;
79              
80             __END__