File Coverage

lib/Test/File/ShareDir/TempDirObject.pm
Criterion Covered Total %
statement 66 68 97.0
branch 13 18 72.2
condition n/a
subroutine 21 21 100.0
pod 1 1 100.0
total 101 108 93.5


line stmt bran cond sub pod time code
1 4     4   492 use 5.006; # pragmas
  4         10  
2 4     4   14 use strict;
  4         5  
  4         65  
3 4     4   12 use warnings;
  4         3  
  4         213  
4              
5             package Test::File::ShareDir::TempDirObject;
6              
7             our $VERSION = '1.001002';
8              
9             # ABSTRACT: Internal Object to make code simpler.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24 4     4   2985 use Path::Tiny qw(path);
  4         40828  
  4         267  
25 4     4   27 use Carp qw(confess);
  4         7  
  4         2447  
26             ## no critic (Subroutines::RequireArgUnpacking)
27 3     3   1534 sub __rcopy { require File::Copy::Recursive; goto \&File::Copy::Recursive::rcopy; }
  3         12976  
28              
29              
30              
31              
32              
33              
34              
35             sub new {
36 3     3 1 6 my ( $class, $config ) = @_;
37              
38 3 50       17 confess('Need -share => for Test::File::ShareDir') unless exists $config->{-share};
39              
40 3         10 my $realconfig = {
41             root => path(q{./})->absolute, #->resolve->absolute,
42             modules => {},
43             dists => {},
44             };
45              
46 3 100       343 $realconfig->{root} = path( delete $config->{-root} )->absolute if exists $config->{-root};
47 3 100       70 $realconfig->{modules} = delete $config->{-share}->{-module} if exists $config->{-share}->{-module};
48 3 100       12 $realconfig->{dists} = delete $config->{-share}->{-dist} if exists $config->{-share}->{-dist};
49              
50 3 50       4 confess( 'Unsupported -share types : ' . join q{ }, keys %{ $config->{-share} } ) if keys %{ $config->{-share} };
  0         0  
  3         10  
51              
52 3         6 delete $config->{-share};
53              
54 3 50       4 confess( 'Unsupported parameter to import() : ' . join q{ }, keys %{$config} ) if keys %{$config};
  0         0  
  3         6  
55              
56 3         8 return bless $realconfig, $class;
57             }
58              
59             my @cache;
60              
61             sub _tempdir {
62 6     6   11 my ($self) = shift;
63 6 100       32 return $self->{tempdir} if exists $self->{tempdir};
64 3         9 $self->{tempdir} = Path::Tiny::tempdir( CLEANUP => 1 );
65              
66             # Explicit keepalive till GC
67 3         45196 push @cache, $self->{tempdir};
68 3         17 return $self->{tempdir};
69             }
70              
71             sub _module_tempdir {
72 2     2   2 my ($self) = shift;
73 2 50       7 return $self->{module_tempdir} if exists $self->{module_tempdir};
74 2         4 $self->{module_tempdir} = $self->_tempdir->child('auto/share/module');
75 2         51 $self->{module_tempdir}->mkpath();
76 2         560 return $self->{module_tempdir}->absolute;
77             }
78              
79             sub _dist_tempdir {
80 1     1   2 my ($self) = shift;
81 1 50       2 return $self->{dist_tempdir} if exists $self->{dist_tempdir};
82 1         1 $self->{dist_tempdir} = $self->_tempdir->child('auto/share/dist');
83 1         26 $self->{dist_tempdir}->mkpath();
84 1         294 return $self->{dist_tempdir}->absolute;
85             }
86              
87             sub _root {
88 3     3   44 my ($self) = shift;
89 3         9 return $self->{root};
90             }
91              
92 5     5   25 sub _modules { return shift->{modules}; }
93              
94 4     4   16 sub _dists { return shift->{dists} }
95              
96             sub _module_names {
97 3     3   4 my ($self) = shift;
98 3         44 return keys %{ $self->_modules };
  3         7  
99             }
100              
101             sub _dist_names {
102 3     3   7 my ($self) = shift;
103 3         5 return keys %{ $self->_dists };
  3         8  
104             }
105              
106             sub _module_share_target_dir {
107 2     2   104 my ( $self, $modname ) = @_;
108              
109             ## no critic (RegularExpressions)
110 2         2 $modname =~ s/::/-/g;
111              
112 2         5 return $self->_module_tempdir->child($modname);
113             }
114              
115             sub _dist_share_target_dir {
116 1     1   46 my ( $self, $distname ) = @_;
117 1         2 return $self->_dist_tempdir->child($distname);
118             }
119              
120             sub _module_share_source_dir {
121 2     2   3 my ( $self, $module ) = @_;
122 2         2 return path( $self->_modules->{$module} )->absolute( $self->_root );
123             }
124              
125             sub _dist_share_source_dir {
126 1     1   1 my ( $self, $dist ) = @_;
127 1         2 return path( $self->_dists->{$dist} )->absolute( $self->_root );
128             }
129              
130             sub _install_module {
131 2     2   2 my ( $self, $module ) = @_;
132 2         2 return __rcopy( $self->_module_share_source_dir($module), $self->_module_share_target_dir($module) );
133             }
134              
135             sub _install_dist {
136 1     1   1 my ( $self, $dist ) = @_;
137 1         3 return __rcopy( $self->_dist_share_source_dir($dist), $self->_dist_share_target_dir($dist) );
138             }
139              
140             1;
141              
142             __END__