File Coverage

lib/Test/File/ShareDir.pm
Criterion Covered Total %
statement 65 70 92.8
branch 9 12 75.0
condition 2 10 20.0
subroutine 13 13 100.0
pod 2 2 100.0
total 91 107 85.0


line stmt bran cond sub pod time code
1 6     6   106360 use 5.006; # pragmas
  6         26  
  6         212  
2 6     6   27 use strict;
  6         9  
  6         174  
3 6     6   24 use warnings;
  6         13  
  6         379  
4              
5             package Test::File::ShareDir;
6              
7             our $VERSION = '1.001000';
8              
9             # ABSTRACT: Create a Fake ShareDir for your modules for testing.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24 6     6   2989 use File::ShareDir 1.00 qw();
  6         32568  
  6         132  
25 6     6   38 use Exporter qw();
  6         9  
  6         94  
26 6     6   2050 use Test::File::ShareDir::Utils qw( extract_dashes );
  6         10  
  6         330  
27 6     6   26 use Carp qw( croak );
  6         6  
  6         214  
28 6     6   2790 use parent qw( Exporter );
  6         1439  
  6         29  
29              
30             our @EXPORT_OK = qw( with_dist_dir with_module_dir );
31              
32             sub import {
33 5     5   56 my ( $package, @args ) = @_;
34              
35 5         8 my ( @imports, %params );
36              
37             # ->import( { }, qw( imports ) )
38 5 50       16 if ( 'HASH' eq ref $args[0] ) {
39 0         0 %params = %{ shift @args };
  0         0  
40 0         0 @imports = @args;
41             }
42             else {
43             # ->import( -arg => value, -arg => value, @imports );
44 5         17 while (@args) {
45 7 100       35 if ( $args[0] =~ /\A-(.*)\z/msx ) {
46 5         13 $params{ $args[0] } = $args[1];
47 5         10 splice @args, 0, 2, ();
48 5         16 next;
49             }
50 2         6 push @imports, shift @args;
51             }
52             }
53              
54 5 100       21 if ( keys %params ) {
55 3         1127 require Test::File::ShareDir::TempDirObject;
56              
57 3         27 my $tempdir_object = Test::File::ShareDir::TempDirObject->new( \%params );
58              
59 3         13 for my $module ( $tempdir_object->_module_names ) {
60 2         6 $tempdir_object->_install_module($module);
61             }
62              
63 3         1961 for my $dist ( $tempdir_object->_dist_names ) {
64 1         4 $tempdir_object->_install_dist($dist);
65             }
66              
67 3         1036 unshift @INC, $tempdir_object->_tempdir->stringify;
68              
69             }
70 5 100       53 if (@imports) {
71 2         189 $package->export_to_level( 1, undef, @imports );
72             }
73 5         175 return;
74              
75             }
76              
77             # This code is just to make sure any guard objects
78             # are not lexically visible to the sub they contain creating a self reference.
79             sub _mk_clearer {
80 2     2   4 my ($clearee) = @_;
81 2     2   28 return sub { $clearee->clear };
  2         4403  
82             }
83              
84              
85              
86              
87              
88              
89              
90              
91              
92              
93              
94              
95              
96              
97              
98              
99              
100              
101              
102              
103              
104              
105              
106              
107              
108              
109             sub with_dist_dir {
110 1     1 1 12 my ( $config, $code ) = @_;
111 1 50 50     38 if ( 'CODE' ne ( ref $code || q{} ) ) {
112 0   0     0 croak( 'CodeRef expected at end of with_dist_dir(), ' . ( ref $code || qq{scalar="$code"} ) . ' found' );
113             }
114 1         495 require Test::File::ShareDir::Object::Dist;
115 1         400 require Scope::Guard;
116 1         339 my $dist_object = Test::File::ShareDir::Object::Dist->new( extract_dashes( 'dists', $config ) );
117 1         86 $dist_object->install_all_dists();
118 1         7 $dist_object->register();
119 1         6 my $guard = Scope::Guard->new( _mk_clearer($dist_object) ); ## no critic (Variables::ProhibitUnusedVarsStricter)
120 1         15 return $code->();
121             }
122              
123              
124              
125              
126              
127              
128              
129              
130              
131              
132              
133              
134              
135              
136              
137              
138              
139              
140              
141              
142              
143              
144              
145              
146              
147              
148             sub with_module_dir {
149 1     1 1 12 my ( $config, $code ) = @_;
150 1 50 50     38 if ( 'CODE' ne ( ref $code || q{} ) ) {
151 0   0     0 croak( 'CodeRef expected at end of with_module_dir(), ' . ( ref $code || qq{scalar="$code"} ) . ' found' );
152             }
153              
154 1         506 require Test::File::ShareDir::Object::Module;
155 1         642 require Scope::Guard;
156              
157 1         550 my $module_object = Test::File::ShareDir::Object::Module->new( extract_dashes( 'modules', $config ) );
158              
159 1         124 $module_object->install_all_modules();
160 1         7 $module_object->register();
161 1         6 my $guard = Scope::Guard->new( _mk_clearer($module_object) ); ## no critic (Variables::ProhibitUnusedVarsStricter)
162              
163 1         23 return $code->();
164             }
165              
166             1;
167              
168             __END__