1# $Id: Repository.pm,v 1.9 2011/09/15 20:59:26 pfeiffer Exp $ 2 3=head1 NAME 4 5Mpp::Repository - Makepp repository functionality 6 7=head1 DESCRIPTION 8 9This file groups all the functions needed only if repositories are actually used. 10The actual functionality is also dispersed in makepp and other modules. 11 12=cut 13 14package Mpp::Repository; # For CPAN scanner. 15package Mpp::File; # Use this a lot. 16 17use Mpp::FileOpt; 18 19sub symlink { 20 CORE::symlink relative_filename( $_[1], $_[0]{'..'} ), 21 &absolute_filename_nolink 22 or die 'error linking ' . absolute_filename( $_[1] ) . ' to ' . &absolute_filename . "--$!\n"; 23 undef $_[0]{xEXISTS}; # We know this file exists now. 24} 25 26# 27# Because automake/autoconfig is so #@%!(#%&!)#$&(^)$(^&!( hacked up, there 28# doesn't seem to be any way to support repositories without simply putting 29# the files in automatically. Automake simply does not properly list 30# dependencies in the makefile, and there's no way around it except to 31# list special cases. These are the files that automake/autoconf appear 32# to need that might not be correctly linked in based on instructions in 33# the makefile. 34# 35my %automake_garbage; 36@automake_garbage{qw(Makefile.in Makefile.am acconfig.h acinclude.m4 aclocal.m4 37config.h config.h.in config.status configure configure.in configure.files 38libtool stamp-h stamp-h.in install.sh install-sh missing mkinstalldirs)} = (); 39 40sub load_single { 41 #my( $finfo, $destfinfo ) = @_; # Name the arguments. 42 return if $_[0]{NAME} =~ /\.la$/ || # Skip libtool stuff--we don't handle it very gracefully right now. 43 &dont_read; 44 45 if( exists $automake_garbage{$_[0]{NAME}} && exists $_[0]{'..'}{DIRCONTENTS}{'Makefile.in'} || 46 $_[0]{'..'}{NAME} eq 'admin' && exists $_[0]{'..'}{'..'}{DIRCONTENTS}{'Makefile.in'} ) { 47 # Is this automake's crap? 48 # Admin directory contains a number of vital files. 49 unless( file_exists $_[1] ) { # Link it in if it's not already there. 50 &mkdir( $_[1]{'..'} ); # Make the destination directory. 51 &symlink( $_[1], $_[0] ); # Add the symbolic link. 52 may_have_changed $_[1]; # File exists now. 53 } 54 } else { 55 push @{$_[1]{ALTERNATE_VERSIONS}}, $_[0]; 56 # Mark this as a possible source. 57 } 58 publish $_[1], $Mpp::rm_stale_files; 59 # This thing exists now, so wildcards can match it. 60} 61 62sub load_recurse { 63 # $top is the top of the destination tree 64 my( $dirinfo, $destdirinfo, $top, $prune_code ) = @_; # Name the arguments. 65 66 # Ignore .makepp directories (and anything else the caller wants) 67 return if $dirinfo->{NAME} eq $build_info_subdir || 68 $prune_code && &$prune_code( $dirinfo ) || 69 &dont_read; 70 71 warn "repositories are ignored by make subprocesses when --traditional-recursive-make is in effect\n" 72 if defined $Mpp::Recursive::traditional; 73 74 # Handle empty directories properly 75 &mark_as_directory; 76 mark_as_directory $destdirinfo; 77 78 if( file_exists $destdirinfo ) { # Local directory exists? 79 is_writable $destdirinfo or return; # Not writable? This is a signal 80 # not to try to incorporate anything from 81 # the repository. 82 } else { # Local directory does not exist? 83 undef $destdirinfo->{xIN_REPOSITORY}; # Remember by placeholder that it did exist 84 # in some repository, so it should spring into existence as needed. 85 } 86 87 local $Mpp::Glob::allow_dot_files = 1; # Temporarily allow dot files, because 88 # we need to look into .libs directories 89 # for libtool support. 90# 91# Scan the directory. For speed reasons, this depends on some internals of 92# the Mpp::File package. 93# 94 $dirinfo->{READDIR} or &read_directory; 95 # Load all the files in the directory. 96 97 foreach( values %{$dirinfo->{DIRCONTENTS}} ) { 98 next if $_ == $top; 99 my $dest_finfo = file_info $_->{NAME}, $destdirinfo; 100 if( is_dir $_ ) { 101 load_recurse( $_, $dest_finfo, $top, $prune_code ); 102 push @{$dest_finfo->{ALTERNATE_VERSIONS}}, $_; 103 publish $dest_finfo, $Mpp::rm_stale_files; 104 # This thing exists now, so wildcards can match it. 105 } elsif( file_exists $_ ) { 106 load_single $_, $dest_finfo; 107 } 108 } 109} 110 111# 112# load $dir, $destdir; 113# 114# For every file in the repository directory, this sets up a build command for 115# a corresponding file in the destination directory. If the file isn't 116# available in the destination directory, then when it is needed, makepp will 117# check whether it is in the repository or not. If so, a soft link is 118# made in the destination directory to the repository directory. 119# 120# If the optional third argument is specified, then it is taken as a coderef 121# to which each dirinfo in $dir is passed. If it returns nonzero, then 122# the directory is ignored. 123# 124sub Mpp::Repository::load { 125 my( $dirinfo, $destdirinfo, $prune_code ) = @_; # Name the arguments. 126 Mpp::log REP_LOAD => $dirinfo, $destdirinfo 127 if $log_level; 128 129 # TBD: Using a repository manifest (in addition to the possibility that 130 # it's wrong) is still pretty slow. It would be better to do lazy computation 131 # of the ALTERNATE_VERSIONS for only the files that we need. 132 # TBD: Don't do this if --nouse_repository_manifest is specified 133 if( is_dir &dereference ) { 134 my $finfo = file_info '.repository_manifest', $dirinfo; 135 if( is_readable $finfo ) { 136 my $fname = absolute_filename $finfo; 137 open MANIFEST, '<', $fname or die "Failed to read $fname--$!"; 138 Mpp::log REP_MANIFEST => $finfo 139 if $Mpp::log_level; 140 # NOTE: In the manifest file, each "Makefile.in" file must be the first 141 # listed entry of the directory that contains it, or else this won't 142 # handle automake stuff properly. 143 while( <MANIFEST> ) { 144 chomp; 145 # TBD: These calls to load_single are expensive. Need to 146 # find out why, and see if we can get around it. 147 load_single file_info( $_, $dirinfo ), file_info $_, $destdirinfo; 148 } 149 return; 150 } 151 load_recurse $dirinfo, $destdirinfo, $destdirinfo, $prune_code; 152 } elsif( &file_exists ) { 153 &load_single; 154 } else { 155 die 'repository ' . &absolute_filename . " doesn't exist\n"; 156 } 157} 158 159 160 161sub Mpp::Repository::no_valid_alt_versions { 162 return 1 unless exists $_[0]{ALTERNATE_VERSIONS}; 163 return unless $Mpp::rm_stale_files; 164 was_built_by_makepp $_ 165 or return 166 for @{$_[0]{ALTERNATE_VERSIONS}}; 167 1; 168} 169 170 171=head2 get 172 173 $status = get $repository_file, $finfo; 174 175Links a file in from a repository into the current directory. 176 177Returns 0 if successful, nonzero if something went wrong. 178 179=cut 180 181sub Mpp::Repository::get { 182 my( $dest_finfo, $src_finfo ) = @_; 183 184 if( $dest_finfo->{DIRCONTENTS} ) { # Is this a directory? 185 if( !$src_finfo->{DIRCONTENTS} ) { 186 Mpp::print_error 'Directory `' . &absolute_filename . "' is in the way of a repository import."; 187 ++$Mpp::failed_count; 188 return 1; 189 } elsif( &mkdir ) { # Just make it if inexistent, don't soft link to it. 190 return 0; 191 } else { 192 Mpp::print_error 'Failed to make directory `' . &absolute_filename . "'--$!."; 193 ++$Mpp::failed_count; 194 return 1; 195 } 196 } 197 198 # Don't link to the repository if the source doesn't exist (even if it 199 # can be built, because we'll build it locally instead). 200 return 0 unless exists_or_can_be_built_norecurse $src_finfo, undef, 1; 201 202 &mkdir( $dest_finfo->{'..'} ); # Make the directory (and its parents) if it doesn't exist. 203 204 Mpp::log REP_LINK => @_ 205 if $Mpp::log_level; 206 207 &check_for_change; # Flush $dest_finfo->{LINK_DEREF} to be safe 208 # (in particular, to make sure that it wasn't 209 # deleted by a 'clean' target). NOTE: Do this 210 # *before* changing build info. 211 212 # NOTE: Even if the symlink is already correct, we need to copy over the 213 # build info, because it may have changed since the link was created. 214 my $binfo = $src_finfo->{BUILD_INFO} ||= 215 load_build_info_file($src_finfo) || {}; 216 # Get the build information for the old file. 217 my %build_info = %$binfo; # Make a copy of everything. 218 $build_info{FROM_REPOSITORY} = relative_filename( $src_finfo, $dest_finfo->{'..'} ); 219 # Remember that we got it from a repository. 220 undef $dest_finfo->{xUPDATE_BUILD_INFOS}; # Remember to update the build info. 221 $dest_finfo->{BUILD_INFO} = \%build_info; 222 push @build_infos_to_update, $dest_finfo; 223 # Update it soon. 224 225 if( dont_read $src_finfo ) { 226 Mpp::print_error 'Cannot link ', $src_finfo, ' to ', $dest_finfo, 227 ' because the former is marked for dont-read'; 228 ++$Mpp::failed_count; 229 return 1; # Indicate failure. 230 } 231 if( &dont_read ) { 232 Mpp::print_error 'Cannot link ', $src_finfo, ' to ', $dest_finfo, 233 ' because the latter is marked for dont-read'; 234 ++$Mpp::failed_count; 235 return 1; # Indicate failure. 236 } 237 238 my $changed = 1; 239 if( &is_symbolic_link ) { # If it's already a symbolic link, 240 # maybe it's correct. 241 $dest_finfo->{LINK_DEREF} or &dereference; 242 # Get the link value. 243 $dest_finfo->{LINK_DEREF} == $src_finfo and $changed = 0; 244 # If it's already right, don't do anything. 245 } 246 247 if( $changed ) { 248 unless( &in_sandbox ) { 249 warn $Mpp::sandbox_warn_flag ? '' : 'error: ', 250 'Cannot link ', absolute_filename( $src_finfo ), ' to ', &absolute_filename, 251 " because the latter is marked for out-of-sandbox\n"; 252 return 1 unless $Mpp::sandbox_warn_flag; # Indicate failure. 253 } 254 &unlink; # Get rid of anything that might already 255 # be there. 256 if( !defined $Mpp::symlink_in_rep_as_file && is_symbolic_link $src_finfo ) { 257 # Must not fetch symlinks from repository, because 258 # they can point to another file in the repository 259 # of which we have a different version locally. 260 $build_info{SYMLINK} = readlink absolute_filename $src_finfo; 261 if( CORE::symlink $build_info{SYMLINK}, &absolute_filename ) { 262 undef $dest_finfo->{xEXISTS}; # We know this file exists now. 263 } else { 264 $@ = "$!"; 265 } 266 } else { 267 eval { &symlink }; # Make the link. 268 } 269 if ($@) { # Did something go wrong? 270 Mpp::print_error 'Cannot link ', $src_finfo, ' to ', $dest_finfo, ":\n$@"; 271 ++$Mpp::failed_count; 272 return 1; # Indicate failure. 273 } 274 ++$Mpp::rep_hits; 275 } else { 276 Mpp::log 'REP_EXISTING' 277 if $Mpp::log_level; 278 } 279 280 # NOTE: This has to happen *after* the file exists (or else the build info 281 # won't be saved), but *before* calling may_have_changed (which erases the 282 # build info). Bad things could happen if it were possible for 283 # update_build_infos to be called after xUPDATE_BUILD_INFOS is set, but 284 # before now. 285 &update_build_infos; # Update it now. This way, the file is marked 286 # as coming from a repository even if the 287 # build command is aborted. Next time around 288 # we'll know that it came from a repository 289 # and we can delete it appropriately. 290 291 if ($changed) { 292 my $build_info = $dest_finfo->{BUILD_INFO}; # Don't flush the build info. 293 # (If we lose the build info, then we don't 294 # clean up this file in 295 # cleanup_temporary_links. TODO: is that still needed?) 296 &may_have_changed; # Flush the stat array cache. 297 $dest_finfo->{BUILD_INFO} = $build_info; 298 $dest_finfo->{SIGNATURE} = signature( $src_finfo ); 299 # Have to have the current signature or else 300 # the build info will get discarded anyway. 301 } 302 303 0; # Indicate success. 304} 305 306 307# 308# This is the actual functions which overloads the stubs. 309# 310no warnings 'redefine'; 311 312sub Mpp::Subs::s_repository { 313 #my( $text_line, $makefile, $makefile_line ) = @_; # Name the arguments. 314 my $cwd = $_[1] ? $_[1]{CWD} : $CWD_INFO; 315 foreach my $rdir ( $_[1] ? split ' ', $_[1]->expand_text( $_[0], $_[2] ) : $_[0] ) { 316 # Get a list of repository directories. 317 if( $rdir =~ /^([^=]+)=(.*)/ ) { # Destination directory specified? 318 my $rinfo = file_info $2, $cwd; 319 my $dst_info = file_info $1, $cwd; 320 Mpp::Repository::load $rinfo, $dst_info; 321 } else { 322 my $rinfo = file_info $rdir, $cwd; 323 # Get the fileinfo structure. 324 Mpp::Repository::load $rinfo, $cwd; 325 # Load all the files. 326 } 327 } 328} 329 330sub Mpp::Subs::s_vpath { 331 #my( $text_line, $makefile, $makefile_line ) = @_; # Name the arguments. 332 my( $pattern, $dirs ) = split ' ', $_[1]->expand_text( $_[0], $_[2] ), 2; 333 unless( defined $pattern && defined $dirs ) { 334 warn "$_[2]: makepp never turns off vpath\n"; 335 return; 336 } 337 if( $pattern eq '%' ) { 338 undef $pattern; 339 } else { 340 $pattern = "\Q$pattern"; 341 $pattern =~ s/\\%/.*/; 342 $pattern = qr/^$pattern$/; # Don't worry about .files, gmake doesn't 343 } 344 my $cwd = $_[1]{CWD}; 345 for my $dir ( split Mpp::is_windows > 1 ? ';' : qr/[\s:]/, $dirs ) { 346 $dir = file_info $dir, $cwd; 347 read_directory $dir; 348 while( my( $name, $finfo ) = each %{$dir->{DIRCONTENTS}} ) { 349 next if $pattern and $name !~ $pattern; 350 load_single $finfo, file_info $name, $cwd; 351 } 352 } 353} 354 3551; 356