File Coverage

blib/lib/Importer/Zim/Utils.pm
Criterion Covered Total %
statement 27 38 71.0
branch 3 6 50.0
condition 1 2 50.0
subroutine 7 9 77.7
pod 0 2 0.0
total 38 57 66.6


line stmt bran cond sub pod time code
1              
2             package Importer::Zim::Utils;
3             $Importer::Zim::Utils::VERSION = '0.12.0';
4             # ABSTRACT: Utilities for Importer::Zim backends
5              
6 5     5   76 use 5.010001;
  5         17  
7              
8             our @EXPORT_OK = qw(DEBUG carp croak);
9              
10             BEGIN {
11 5   50 5   51 my $v = $ENV{IMPORTER_ZIM_DEBUG} || 0;
12 5         499 *DEBUG = sub () {$v};
  0         0  
13             }
14              
15 0     0 0 0 sub carp { require Carp; goto &Carp::carp; }
  0         0  
16 0     0 0 0 sub croak { require Carp; goto &Carp::croak; }
  0         0  
17              
18             ### import / unimport machinery
19              
20             BEGIN {
21             my $v
22             = $ENV{IMPORTER_ZIM_NO_LEXICAL}
23 5 50   5   346 ? !1
  5     5   424  
  0         0  
  0         0  
24             : !!eval 'use Sub::Inject 0.2.0 (); 1';
25 5         1536 *USE_LEXICAL_SUBS = sub () {$v};
  0         0  
26             }
27              
28             sub import {
29 6     6   19 my $exports = shift->_get_exports(@_);
30              
31 6         8 if (USE_LEXICAL_SUBS) {
32             @_ = %$exports;
33             goto &Sub::Inject::sub_inject;
34             }
35              
36 6         13 my $caller = caller;
37 6         21 *{ $caller . '::' . $_ } = $exports->{$_} for keys %$exports;
  17         6837  
38             }
39              
40             sub unimport {
41 6     6   38 my $exports = shift->_get_exports(@_);
42              
43 6         12 return if USE_LEXICAL_SUBS;
44              
45 6         13 my $caller = caller;
46 6         22 delete ${"${caller}::"}{$_} for keys %$exports;
  17         194  
47             }
48              
49             # BEWARE! unimport() will nuke the entire glob associated to
50             # an imported subroutine (if USE_LEXICAL_SUBS is false).
51             # So don't use scalar / hash / array variables with the same
52             # names as any of the symbols in @EXPORT_OK in the user modules.
53              
54             sub _get_exports {
55 12     12   25 my $class = shift;
56              
57 12         22 state $EXPORTABLE = { map { $_ => \&{$_} } @EXPORT_OK };
  15         21  
  15         46  
58              
59 12         23 my ( %exports, @bad );
60 12         26 for (@_) {
61 34 50       90 push( @bad, $_ ), next unless my $sub = $EXPORTABLE->{$_};
62 34         71 $exports{$_} = $sub;
63             }
64 12 50       30 if (@bad) {
65 0         0 my @carp;
66 0         0 push @carp, qq["$_" is not exported by the $class module\n] for @bad;
67 0         0 croak(qq[@{carp}Can't continue after import errors]);
68             }
69 12         31 return \%exports;
70             }
71              
72             1;
73              
74             #pod =encoding utf8
75             #pod
76             #pod =head1 SYNOPSIS
77             #pod
78             #pod use Importer::Zim::Utils qw(DEBUG carp croak);
79             #pod ...
80             #pod no Importer::Zim::Utils qw(DEBUG carp croak);
81             #pod
82             #pod =head1 DESCRIPTION
83             #pod
84             #pod "For longer than I can remember, I've been looking for someone like you."
85             #pod – Tak
86             #pod
87             #pod No public interface.
88             #pod
89             #pod =head1 SEE ALSO
90             #pod
91             #pod L
92             #pod
93             #pod =cut
94              
95             __END__