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   108345 use 5.006; # pragmas
  6         20  
  6         213  
2 6     6   28 use strict;
  6         6  
  6         184  
3 6     6   23 use warnings;
  6         14  
  6         424  
4              
5             package Test::File::ShareDir;
6              
7             our $VERSION = '1.001001';
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   2886 use File::ShareDir 1.00 qw();
  6         34216  
  6         150  
25 6     6   43 use Exporter qw();
  6         6  
  6         83  
26 6     6   2482 use Test::File::ShareDir::Utils qw( extract_dashes );
  6         9  
  6         385  
27 6     6   36 use Carp qw( croak );
  6         7  
  6         267  
28 6     6   3077 use parent qw( Exporter );
  6         1492  
  6         30  
29              
30             our @EXPORT_OK = qw( with_dist_dir with_module_dir );
31              
32             sub import {
33 5     5   59 my ( $package, @args ) = @_;
34              
35 5         7 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         18 while (@args) {
45 7 100       36 if ( $args[0] =~ /\A-(.*)\z/msx ) {
46 5         8 $params{ $args[0] } = $args[1];
47 5         9 splice @args, 0, 2, ();
48 5         16 next;
49             }
50 2         7 push @imports, shift @args;
51             }
52             }
53              
54 5 100       20 if ( keys %params ) {
55 3         1030 require Test::File::ShareDir::TempDirObject;
56              
57 3         25 my $tempdir_object = Test::File::ShareDir::TempDirObject->new( \%params );
58              
59 3         10 for my $module ( $tempdir_object->_module_names ) {
60 2         5 $tempdir_object->_install_module($module);
61             }
62              
63 3         2391 for my $dist ( $tempdir_object->_dist_names ) {
64 1         2 $tempdir_object->_install_dist($dist);
65             }
66              
67 3         1070 unshift @INC, $tempdir_object->_tempdir->stringify;
68              
69             }
70 5 100       61 if (@imports) {
71 2         265 $package->export_to_level( 1, undef, @imports );
72             }
73 5         211 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   3 my ($clearee) = @_;
81 2     2   22 return sub { $clearee->clear };
  2         2788  
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 708 my ( $config, $code ) = @_;
111 1 50 50     39 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         599 require Test::File::ShareDir::Object::Dist;
115 1         394 require Scope::Guard;
116 1         308 my $dist_object = Test::File::ShareDir::Object::Dist->new( extract_dashes( 'dists', $config ) );
117 1         72 $dist_object->install_all_dists();
118 1         5 $dist_object->register();
119 1         4 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 15 my ( $config, $code ) = @_;
150 1 50 50     39 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         566 require Test::File::ShareDir::Object::Module;
155 1         392 require Scope::Guard;
156              
157 1         320 my $module_object = Test::File::ShareDir::Object::Module->new( extract_dashes( 'modules', $config ) );
158              
159 1         77 $module_object->install_all_modules();
160 1         6 $module_object->register();
161 1         4 my $guard = Scope::Guard->new( _mk_clearer($module_object) ); ## no critic (Variables::ProhibitUnusedVarsStricter)
162              
163 1         16 return $code->();
164             }
165              
166             1;
167              
168             __END__