File Coverage

blib/lib/Sub/Exporter/Progressive.pm
Criterion Covered Total %
statement 76 78 97.4
branch 19 28 67.8
condition 3 7 42.8
subroutine 9 9 100.0
pod 0 1 0.0
total 107 123 86.9


line stmt bran cond sub pod time code
1             package Sub::Exporter::Progressive;
2             $Sub::Exporter::Progressive::VERSION = '0.001013';
3 6     6   94480 use strict;
  6         9  
  6         133  
4 6     6   19 use warnings;
  6         8  
  6         459  
5              
6             # ABSTRACT: Only use Sub::Exporter if you need it
7              
8             sub _croak {
9 1     1   4 require Carp;
10 1         148 &Carp::croak;
11             }
12              
13             sub import {
14 7     7   139 my ($self, @args) = @_;
15              
16 7         12 my $inner_target = caller;
17 7         13 my $export_data = sub_export_options($inner_target, @args);
18              
19 7         7 my $full_exporter;
20 6     6   20 no strict 'refs';
  6         8  
  6         142  
21 6     6   21 no warnings 'once';
  6         7  
  6         483  
22 7         4 @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
  7         31  
  7         14  
23 7         7 @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
  7         23  
  7         7  
24 7         5 %{"${inner_target}::EXPORT_TAGS"} = %{$export_data->{tags}};
  7         24  
  7         12  
25 7         23 *{"${inner_target}::import"} = sub {
26 6     6   21 use strict;
  6         6  
  6         3055  
27 18     18   8200 my ($self, @args) = @_;
28              
29 18 100       36 if ( grep {
    100          
30 21 100       149 length ref $_
31             or
32             $_ !~ / \A [:-]? \w+ \z /xm
33             } @args ) {
34             _croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed'
35 1 50       1 unless eval { require Sub::Exporter };
  1         8  
36 1   33     4 $full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});
37              
38 1         141 goto $full_exporter;
39 19         48 } elsif ( defined( (my ($num) = grep { m/^\d/ } @args)[0] ) ) {
40 1         5 _croak "cannot export symbols with a leading digit: '$num'";
41             } else {
42 16         60 require Exporter;
43 16         54 s/ \A - /:/xm for @args;
44 16         44 @_ = ($self, @args);
45 16         4145 goto \&Exporter::import;
46             }
47 7         26 };
48 7         246 return;
49             }
50              
51             my $too_complicated = <<'DEATH';
52             You are using Sub::Exporter::Progressive, but the features your program uses from
53             Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
54             just use vanilla Sub::Exporter
55             DEATH
56              
57             sub sub_export_options {
58 7     7 0 8 my ($inner_target, $setup, $options) = @_;
59              
60 7         9 my @exports;
61             my @defaults;
62 0         0 my %tags;
63              
64 7 50 50     29 if ( ($setup||'') eq '-setup') {
65 7         28 my %options = %$options;
66              
67             OPTIONS:
68 7         14 for my $opt (keys %options) {
69 13 100       31 if ($opt eq 'exports') {
    50          
70              
71 7 50       38 _croak $too_complicated if ref $options{exports} ne 'ARRAY';
72 7         6 @exports = @{$options{exports}};
  7         12  
73 7 50       8 _croak $too_complicated if grep { length ref $_ } @exports;
  18         35  
74              
75             } elsif ($opt eq 'groups') {
76 6         15 %tags = %{$options{groups}};
  6         19  
77 6         10 for my $tagset (values %tags) {
78             _croak $too_complicated if grep {
79 12 50       77 length ref $_
80             or
81             $_ =~ / \A - (?! all \b ) /x
82 11 50       11 } @{$tagset};
  11         12  
83             }
84 6 50       9 @defaults = @{$tags{default} || [] };
  6         22  
85             } else {
86 0         0 _croak $too_complicated;
87             }
88             }
89 7 100       16 @{$_} = map { / \A [:-] all \z /x ? @exports : $_ } @{$_} for \@defaults, values %tags;
  18         23  
  18         52  
  18         20  
90 7   50     36 $tags{all} ||= [ @exports ];
91 7         7 my %exports = map { $_ => 1 } @exports;
  18         32  
92 7         10 my @errors = grep { not $exports{$_} } @defaults;
  7         13  
93 7 50       22 _croak join(', ', @errors) . " is not exported by the $inner_target module\n" if @errors;
94             }
95              
96             return {
97 7         24 exports => \@exports,
98             defaults => \@defaults,
99             original => $options,
100             tags => \%tags,
101             };
102             }
103              
104             1;
105              
106             __END__