File Coverage

blib/lib/Exporter/Tidy.pm
Criterion Covered Total %
statement 35 35 100.0
branch 23 26 88.4
condition 6 10 60.0
subroutine 2 2 100.0
pod n/a
total 66 73 90.4


line stmt bran cond sub pod time code
1             package Exporter::Tidy;
2              
3             # use strict;
4             # no strict 'refs';
5              
6             # our
7             $VERSION = '0.08';
8              
9             sub import {
10 5     5   615 my (undef, %tags) = @_;
11 5         12 my $caller = caller;
12 5         11 my $map = delete($tags{_map});
13            
14 5         6 my %available;
15 5 100       30 @available{ grep !ref, keys %$map } = () if $map;
16 5         46 @available{ grep !/^:/, map @$_, values %tags } = ();
17              
18 5   50     43 $tags{all} ||= [ keys %available ];
19              
20 5         587 *{"$caller\::import"} = sub {
21 4     4   237 my ($me, @symbols) = @_;
22 4         9 my $caller = caller;
23 4 100 66     22 @symbols = @{ $tags{default} } if @symbols == 0 and exists $tags{default};
  1         4  
24 4         6 my %exported;
25 4         5 my $prefix = '';
26 4         12 while (my $symbol = shift @symbols) {
27 23 100       45 $symbol eq '_prefix' and ($prefix = shift @symbols, next);
28 21 100 66     63 my $real = $map && exists $map->{$symbol} ? $map->{$symbol} : $symbol;
29 21 50       48 next if exists $exported{"$prefix$real"};
30 21         33 undef $exported{"$prefix$symbol"};
31 21         19 $i++;
32 1         8 $real =~ /^:(.*)/ and (
33             (exists $tags{$1} or
34             (require Carp, Carp::croak("Unknown tag: $1"))),
35 21 100 50     57 push(@symbols, @{ $tags{$1} }),
36             next
37             );
38 5         186 ref $real and (
39             $symbol =~ s/^[\@\$%*]//,
40 20 100       47 *{"$caller\::$prefix$symbol"} = $real,
41             next
42             );
43 15 50       28 exists $available{$symbol} or
44             (require Carp, Carp::croak("Unknown symbol: $real"));
45 15         99 my ($sigil, $name) = $real =~ /^([\@\$%*]?)(.*)/;
46 15         40 $symbol =~ s/^[\@\$%*]//;
47 15         2434 *{"$caller\::$prefix$symbol"} =
  3         10  
48 3         10 $sigil eq '' ? \&{"$me\::$name"}
49 3         9 : $sigil eq '$' ? \${"$me\::$name"}
50 3         10 : $sigil eq '@' ? \@{"$me\::$name"}
51 3         9 : $sigil eq '%' ? \%{"$me\::$name"}
52 15 50       53 : $sigil eq '*' ? \*{"$me\::$name"}
    100          
    100          
    100          
    100          
53             : (require Carp, Carp::croak("Strange symbol: $real"));
54             }
55 5         42 };
56             }
57              
58             1;
59              
60             __END__