File Coverage

lib/Module/Build/SysPath.pm
Criterion Covered Total %
statement 33 145 22.7
branch 0 56 0.0
condition 0 23 0.0
subroutine 11 19 57.8
pod 2 2 100.0
total 46 245 18.7


line stmt bran cond sub pod time code
1             package Module::Build::SysPath;
2              
3 3     3   637563 use warnings;
  3         25  
  3         212  
4 3     3   29 use strict;
  3         10  
  3         177  
5              
6             our $VERSION = '0.18';
7              
8 3     3   24 use base 'Module::Build';
  3         10  
  3         1595  
9 3     3   220134 use Sys::Path 0.11;
  3         95452  
  3         49  
10 3     3   79 use List::MoreUtils 'any';
  3         7  
  3         18  
11 3     3   2473 use FindBin '$Bin';
  3         1856  
  3         336  
12 3     3   21 use Digest::MD5 qw(md5_hex);
  3         6  
  3         101  
13 3     3   15 use Text::Diff 'diff';
  3         8  
  3         99  
14 3     3   14 use File::Spec;
  3         6  
  3         25  
15 3     3   42 use File::Basename 'basename', 'dirname';
  3         7  
  3         144  
16 3     3   18 use File::Path 'make_path';
  3         9  
  3         3543  
17              
18             our $sys_path_config_name = 'SPc';
19              
20             sub new {
21 0     0 1   my $class = shift;
22 0           my $builder = $class->SUPER::new(@_);
23 0           my $module = $builder->module_name;
24              
25             # normalize module name (some people write - instead of ::) and add config level
26 0           $module =~ s/-/::/g;
27 0           $module .= '::'.$sys_path_config_name;
28            
29 0           do {
30 0           unshift @INC, File::Spec->catdir($Bin, 'lib');
31 0 0         eval "use $module"; die $@ if $@;
  0            
32             };
33            
34 0           my $distribution_root = Sys::Path->find_distribution_root($builder->module_name);
35 0           print 'dist root is ', $distribution_root, "\n";
36            
37             # map conf files to array of real paths
38             my @conffiles = (
39 0 0         map { ref $_ eq 'ARRAY' ? File::Spec->catfile(@{$_}) : $_ } # convert path array to file name strings
  0            
40 0 0         @{$builder->{'properties'}->{'conffiles'} || []} # all conffiles
  0            
41             );
42            
43 0           my %spc_properties = (
44             'path_types' => [ $module->_path_types ],
45             );
46 0           my %rename_in_system;
47             my %conffiles_in_system;
48 0           my @writefiles_in_system;
49 0           my @create_folders_in_system;
50 0           foreach my $path_type ($module->_path_types) {
51 0           my $sys_path = $module->$path_type;
52 0           my $install_path = Sys::Path->$path_type;
53            
54 0   0       $builder->{'properties'}->{$path_type.'_files'} ||= {};
55              
56             # store for install time retrieval
57 0           $spc_properties{'path'}->{$path_type} = $install_path;
58              
59             # skip prefix and localstatedir those are not really destination paths
60             next
61 0 0   0     if any { $_ eq $path_type } ('prefix' ,'localstatedir');
  0            
62              
63             # prepare a list of files to install
64 0     0     my $non_persistant = (any { $_ eq $path_type} qw(cachedir logdir spooldir rundir lockdir sharedstatedir));
  0            
65 0 0         if (-d $sys_path) {
66 0           my %files;
67             my @ignore_folders;
68 0           foreach my $file (@{$builder->rscan_dir($sys_path)}) {
  0            
69             # skip folders, but remember folders with . prefix
70 0 0         if (-d $file) {
71 0           $file =~ s/$distribution_root.//;
72              
73             # ignore folders with . prefix
74             push @ignore_folders, File::Spec->catfile($file, '') # File::Spec with empty string to add portable trailing slash
75 0 0 0       if (basename($file) =~ m{^\.} and (not exists $builder->{'properties'}->{$path_type.'_files'}->{$file}));
76              
77 0           next;
78             }
79            
80 0           my $blib_file = $file;
81 0           my $dest_file = $file;
82 0           $file =~ s/$distribution_root.//;
83 0           $dest_file =~ s/^$sys_path/$install_path/;
84 0           $blib_file =~ s/^$sys_path.//;
85 0           $blib_file = File::Spec->catfile($path_type, $blib_file);
86            
87             # allow empty directories to be created
88 0 0         push @create_folders_in_system, dirname($dest_file)
89             if (basename($file) eq '.exists');
90            
91             # skip non-persistant folders, only include explicitely wanted and .exists files
92             next if
93             $non_persistant
94 0 0 0       and (not exists $builder->{'properties'}->{$path_type.'_files'}->{$file})
95             ;
96            
97             # skip files from .folders, only include explicitely wanted
98             next if any {
99             ($file =~ m/^$_/)
100 0 0   0     and (not exists $builder->{'properties'}->{$path_type.'_files'}->{$file})
101 0 0         } @ignore_folders;
102            
103             # skip files with . prefix
104             next if
105 0 0 0       (basename($file) =~ m/^\./)
106             and (basename($file) ne '.exists')
107             ;
108            
109             # print 'file> ', $file, "\n";
110             # print 'bfile> ', $blib_file, "\n";
111             # print 'dfile> ', $dest_file, "\n\n";
112            
113 0 0   0     if (any { $_ eq $file } @conffiles) {
  0            
114 0           $conffiles_in_system{$dest_file} = md5_hex(IO::Any->slurp([$file]));
115            
116 0           my $diff;
117 0 0         $diff = diff($file, $dest_file, { STYLE => 'Unified' })
118             if -f $dest_file;
119 0 0 0       if (
120             $diff # prompt when files differ
121             and Sys::Path->changed_since_install($dest_file) # and only if the file changed on filesystem
122             ) {
123             # prompt if to overwrite conf or not
124 0 0 0       if (
125             # only if the distribution conffile changed since last install
126             Sys::Path->changed_since_install($dest_file, $file)
127             and Sys::Path->prompt_cfg_file_changed(
128             $file,
129             $dest_file,
130 0     0     sub { $builder->prompt(@_) },
131             )
132             ) {
133 0           $rename_in_system{$dest_file} = $dest_file.'-old';
134             }
135             else {
136 0           $blib_file .= '-spc';
137 0           $dest_file .= '-spc';
138             }
139             }
140             }
141              
142             # add file the the Build.PL _files list
143 0           $files{$file} = $blib_file;
144              
145             # make the conf and state files writable in the system
146             push @writefiles_in_system, $dest_file
147 0 0   0     if any { $_ eq $path_type } qw(sharedstatedir sysconfdir);
  0            
148             }
149 0           $builder->{'properties'}->{$path_type.'_files'} = \%files;
150             }
151            
152             # set installation paths
153 0           $builder->{'properties'}->{'install_path'}->{$path_type} = $install_path;
154            
155             # add build elements of the path types
156 0           $builder->add_build_element($path_type);
157             }
158 0           $builder->{'properties'}->{'spc'} = \%spc_properties;
159 0           $builder->notes('rename_in_system' => \%rename_in_system);
160 0           $builder->notes('conffiles_in_system' => \%conffiles_in_system);
161 0           $builder->notes('writefiles_in_system' => \@writefiles_in_system);
162 0           $builder->notes('create_folders_in_system' => \@create_folders_in_system);
163            
164 0           return $builder;
165             }
166              
167             sub ACTION_install {
168 0     0 1   my $builder = shift;
169 0           my $destdir = $builder->{'properties'}->{'destdir'};
170              
171             # move system file for backup (only when really installing to system)
172 0 0         if (not $destdir) {
173 0           my %rename_in_system = %{$builder->notes('rename_in_system')};
  0            
174 0           while (my ($system_file, $new_system_file) = each %rename_in_system) {
175 0           print 'Moving ', $system_file,' -> ', $new_system_file, "\n";
176 0 0         rename($system_file, $new_system_file) or die $!;
177             }
178             }
179            
180             # create requested folders
181 0           foreach my $folder (@{$builder->notes('create_folders_in_system')}) {
  0            
182 0   0       $folder = File::Spec->catdir($destdir || (), $folder);
183 0 0         if (not -d $folder) {
184 0           print 'Creating '.$folder.' folder', "\n";
185 0           make_path($folder);
186             }
187             }
188              
189 0           $builder->SUPER::ACTION_install(@_);
190              
191 0           my $module = $builder->module_name;
192              
193 0           my $path_types = join('|', @{$builder->{'properties'}->{'spc'}->{'path_types'}});
  0            
194            
195             # normalize module name (some people write - instead of ::) and add config level
196 0           $module =~ s/-/::/g;
197 0           $module .= '::'.$sys_path_config_name;
198            
199             # get path to blib and just installed SPc.pm
200 0           my $module_filename = $module.'.pm';
201 0           $module_filename =~ s{::}{/}g;
202             my $installed_module_filename = File::Spec->catfile(
203 0           $builder->install_map->{File::Spec->catdir(
204             $builder->blib,
205             'lib',
206             )},
207             $module_filename
208             );
209 0           $module_filename = File::Spec->catfile($builder->blib, 'lib', $module_filename);
210            
211 0 0         die 'no such file - '.$module_filename
212             if not -f $module_filename;
213 0 0         die 'no such file - '.$installed_module_filename
214             if not -f $installed_module_filename;
215 0           unlink $installed_module_filename;
216            
217             # write the new version of SPc.pm
218 0 0         open(my $config_fh, '<', $module_filename) or die $!;
219 0 0         open(my $real_config_fh, '>', $installed_module_filename) or die $!;
220 0           while (my $line = <$config_fh>) {
221 0 0         next if ($line =~ m/# remove after install$/);
222 0 0         if ($line =~ m/^sub \s+ ($path_types) \s* {/xms) {
223             $line =
224             'sub '
225             .$1
226             ." {'"
227 0           .$builder->{'properties'}->{'spc'}->{'path'}->{$1}
228             ."'};\n"
229             ;
230             }
231 0           print $real_config_fh $line;
232             }
233 0           close($real_config_fh);
234 0           close($config_fh);
235            
236             # see https://rt.cpan.org/Ticket/Display.html?id=49579
237             # ExtUtils::Install is forcing 0444 so we have to hack write permition after install :-/
238 0           foreach my $writefile (@{$builder->notes('writefiles_in_system')}) {
  0            
239 0 0 0       chmod 0644, File::Spec->catfile($destdir || (), $writefile) or die $!;
240             }
241            
242             # record md5sum of new distribution conffiles (only when really installing to system)
243 0 0         Sys::Path->install_checksums(%{$builder->notes('conffiles_in_system')})
  0            
244             if (not $destdir);
245            
246 0           return;
247             }
248              
249             1;
250              
251              
252             __END__