1# $Id: FileOpt.pm,v 1.114 2012/02/07 22:26:15 pfeiffer Exp $ 2 3=head1 NAME 4 5Mpp::FileOpt -- optional subs to complement Mpp::File 6 7=head1 DESCRIPTION 8 9This file defines some additional subroutines for the Mpp::File package that 10are useful only within makepp. This allows Mpp/File.pm to be used outside 11of makepp itself. 12 13=cut 14 15package Mpp::File; 16 17use Mpp::File; # Our basis. 18 19use strict; 20 21our $build_info_subdir = '.makepp'; 22 # The name of the subdirectory that we store 23 # build information in. 24 25our @build_infos_to_update; # References to all the build info files that 26 # have to be flushed to disk. 27 28our $n_last_chance_rules; # Number of last-chance rules seen this run. 29 30=head2 build_info_string 31 32 my $string = build_info_string($finfo,'key'); 33 my @strings = build_info_string($finfo,qw'key1 key2 ...'); 34 35Returns information about this file which was saved on the last build. This 36information is stored in a separate file, and is automatically invalidated 37if the file it refers to has changed. It is intended for remembering things 38like the command used to build the file when it was last built, or the 39signatures of the dependencies. 40 41See also: set_build_info_string 42 43=cut 44 45sub build_info_string { 46 return undef unless &file_exists; 47 48 my $binfo = $_[0]{BUILD_INFO} ||= 49 # We haven't loaded the build information? 50 &load_build_info_file || # See if there's a build info file. 51 {}; # If we can't find any build information, 52 # at least cache the failure so we don't try 53 # again. 54 55 if( wantarray ) { 56 shift; 57 @{$binfo}{@_}; # This would deliver length in scalar context. 58 } else { 59 $binfo->{$_[1]}; 60 } 61} 62 63=head2 get_rule 64 65 my $rule = get_rule( $finfo, $no_last_chance ); 66 67Returns the rule to build the file, if there is one, or undef if there is none. 68If $no_last_chance is set, then don't consider last chance rules or autoloads. 69 70=cut 71 72sub get_rule { 73 return undef if &dont_build; 74 my $mdir = $_[0]{'..'}; 75 Mpp::Makefile::implicitly_load($mdir); # Make sure we've loaded a makefile for this directory. 76 # If we know the rule now, then return it. Otherwise, try to find a "backwards inference" rule. 77 return $_[0]{RULE} if exists $_[0]{RULE}; 78 if( $n_last_chance_rules && !$_[1] ) { 79 # NOTE: Similar to Mpp::File::publish(), but we stop on the first match, 80 # and there is no stale handling. 81 my $finfo = $_[0]; 82 my $fname = $finfo->{NAME}; 83 my $dirinfo = $mdir; 84 my $leaf = 1; 85 DIR: while ($dirinfo) { 86 for my $arr ( @{$dirinfo->{LAST_CHANCE}} ) { 87 # my( $re, $wild_rtn, $deep, $need_dir ) = @$arr; 88 next unless $leaf || $arr->[2]; 89 next if $fname !~ $arr->[0]; 90 next if $arr->[3] && !is_or_will_be_dir $finfo; 91 $arr->[1]( $finfo ); 92 last DIR; 93 } 94 substr $fname, 0, 0, $dirinfo->{NAME} . '/'; 95 $dirinfo = $dirinfo->{'..'}; 96 undef $leaf; 97 } 98 $finfo->{RULE} or do { 99 if( my $minfo = $mdir->{MAKEINFO} ) { 100 while( my $auto = shift @{$minfo->{AUTOLOAD} || []} ) { 101 Mpp::log AUTOLOAD => $finfo; 102 Mpp::Makefile::load( $auto, $mdir, {}, '', [], $minfo->{ENVIRONMENT}, undef, 'AUTOLOAD' ); 103 last if exists $finfo->{RULE}; 104 } 105 } 106 $finfo->{RULE} 107 } 108 } 109} 110 111=head2 exists_or_can_be_built 112 113=head2 exists_or_can_be_built_or_remove 114 115 if (exists_or_can_be_built( $finfo )) { ... } 116 117Returns true (actually, returns the Mpp::File structure) if the file 118exists and is readable, or does not yet exist but can be built. This 119function determines whether a file exists by checking the build 120signature, not by actually looking in the file system, so if you set 121up a signature function that can return a valid build signature for a 122pseudofile (like a dataset inside an HDF file or a member of an 123archive) then this function will return true. 124 125If this is not what you want, then consider the function file_exists(), which 126looks in the file system to see whether the file exists or not. 127 128The ..._or_remove variant removes the file if $Mpp::rm_stale_files is set 129and the file is stale. 130You shouldn't call this unless you're confident that the file's rule will not 131be learned later, but it's exactly what you need for scanners, because if 132you don't remove stale files from the search path, then they'll get picked 133up erroneously (by the command itself, but usually *not* by the scanner) 134when they are in front of the file's new directory. 135 136Optimization: The results of exists_or_can_be_built_norecurse (and hence 137exists_or_can_be_built) are cached in EXISTS_OR_CAN_BE_BUILT. But, since this 138function used to get called an obscene number of times, they don't themselves 139check the cache, instead providing it to its potential caller. 140 141=cut 142 143my %warned_stale; 144sub exists_or_can_be_built_norecurse { 145 my ($finfo, $phony, $stale) = @_; 146 return exists $finfo->{xPHONY} && $phony ? $finfo : 0 147 if $phony || exists $finfo->{xPHONY}; 148 # Never return phony targets unless requested. 149 150 # lstat and stat calls over NFS take a long time, so if we do the lstat and 151 # find it doesn't exists, then we need to avoid doing the stat too. This 152 # also comes into play a few lines later, where we don't check the signature 153 # when we know the file doesn't exists, unless the object is of a subclass 154 # where the signature method might be overridden. 155 if( &is_symbolic_link ) { 156 &dont_build or 157 $finfo->{BUILD_INFO} ||= &load_build_info_file; # blow away bogus repository links 158 } elsif( exists $finfo->{xEXISTS} && 159 !&have_read_permission) { # File exists, but can't be read, and 160 # isn't a broken symbolic link? 161 return $finfo->{EXISTS_OR_CAN_BE_BUILT} = 0; 162 # Can't be read--ignore it. This is used 163 # to inhibit imports from repositories. 164 } 165 166 if( exists $finfo->{xEXISTS} ) { # We know it exists? 167 # If we think it's a stale file when this is called, then just pretend 168 # it isn't there, but don't remove it because we might find out later 169 # that there is a rule for it. 170 if(!$stale && $Mpp::rm_stale_files && &is_stale) { 171 Mpp::log MAYBE_STALE => $finfo 172 if $Mpp::log_level && !$warned_stale{int $finfo} and $warned_stale{int $finfo} = $finfo; 173 return undef; 174 } 175 $finfo->{EXISTS_OR_CAN_BE_BUILT} = 1; 176 return $finfo; 177 } 178 undef; 179} 180sub exists_or_can_be_built { 181 # If $phony is set, then return only phony targets, which are otherwise ignored. 182 # If $stale is set, then return stale generated files too, even if 183 # $Mpp::rm_stale_files is set. 184 # If $no_last_chance is set, then don't return generated files if the only 185 # rule to build them is a last-chance rule that we haven't already instanced. 186 my ($finfo, $phony, $stale, $no_last_chance) = @_; 187 188 if( &dont_build ) { 189 &lstat_array; 190 return unless exists $finfo->{xEXISTS}; 191 } 192 &is_or_will_be_dir if $Mpp::File::directory_first_reference_hook; 193 my $result = ($phony || !exists $finfo->{EXISTS_OR_CAN_BE_BUILT}) ? 194 &exists_or_can_be_built_norecurse : 195 $finfo->{EXISTS_OR_CAN_BE_BUILT} ? $finfo : 0; 196 return $result || undef if defined $result; 197 my $already_loaded_makefile = $finfo->{'..'}{MAKEINFO}; 198 return $finfo if 199 $finfo->{ADDITIONAL_DEPENDENCIES} || 200 # For legacy makefiles, sometimes an idiom like 201 # this is used: 202 # y.tab.c: y.tab.h 203 # y.tab.h: parse.y 204 # yacc -d parse.y 205 # in order to indicate that the yacc command 206 # has two targets. We need to support this 207 # by indicating that files with extra 208 # dependencies are buildable, even if there 209 # isn't an actual rule for them. 210 get_rule( $finfo, $no_last_chance ) && (!exists $finfo->{xPHONY} xor $phony) || 211 !$already_loaded_makefile && &exists_or_can_be_built_norecurse; 212 # Rule for building it (possibly undef'ed if 213 # it was already built)? Note that even if it 214 # looked stale to begin with, it could have 215 # been built by calling get_rule. 216 # Exists in repository? 217 if( exists $finfo->{ALTERNATE_VERSIONS} ) { 218 for( @{$finfo->{ALTERNATE_VERSIONS}} ) { 219 $result = exists_or_can_be_built_norecurse $_, $phony, $stale; 220 return $result || undef if defined $result; 221 } 222 } 223 undef; 224} 225sub exists_or_can_be_built_or_remove { 226 my $finfo = $_[0]; 227 if( &dont_build ) { 228 &lstat_array; 229 return unless exists $finfo->{xEXISTS}; 230 } 231 $warned_stale{int $finfo} = $finfo if $Mpp::rm_stale_files; # Avoid redundant warning 232 my $result = &exists_or_can_be_built; 233 return $result if $result || !$Mpp::rm_stale_files; 234 if( exists $finfo->{xEXISTS} || &signature ) { 235 unless( &was_built_by_makepp ) { 236 die '`' . &absolute_filename . "' is both a source file and a phony target\n" if exists $finfo->{xPHONY}; 237 return unless &have_read_permission; # Hidden from mpp. 238 } 239 Mpp::log DEL_STALE => $finfo 240 if $Mpp::log_level; 241 # TBD: What if the unlink fails? 242 &unlink; 243 # Remove the build info file as well, so that it won't be treated as 244 # a generated file if something other than makepp puts it back with the 245 # same signature. 246 CORE::unlink &build_info_fname; 247 } 248 $result; 249} 250 251#=head2 clean_fileinfos 252 253# clean_fileinfos($dirinfo) 254 255#Discards all the build information for all files in the given directory 256#after making sure they've been written out to disk. Also discards all 257#Mpp::File objects for files which we haven't tried to build and don't have 258#a build rule. 259 260#=cut 261#sub clean_fileinfos { 262# 263# For some reason, the code below doesn't actually save very much memory at 264# all, and it occasionally causes problems like extra rebuilds or 265# forgetting about rules for some targets. I don't understand how this 266# is possible, but it happened. 267# 268 269# my $dirinfo = $_[0]; # Get the directory. 270 271# &update_build_infos; # Make sure everything's written out. 272# my ($fname, $finfo); 273 274# my @deletable; 275 276# while (($fname, $finfo) = each %{$dirinfo->{DIRCONTENTS}}) { 277# # Look at each file: 278# delete $finfo->{BUILD_INFO}; # Build info can get pretty large. 279# delete $finfo->{LSTAT}; # Toss this too, because we probably won't need 280# # it again. 281# $finfo->{DIRCONTENTS} and clean_fileinfos($finfo); 282# # Recursively clean the whole tree. 283# next if exists $finfo->{BUILD_HANDLE}; # Don't forget the files we tried to build. 284# next if $finfo->{RULE}; # Don't delete something with a rule. 285# next if $finfo->{DIRCONTENTS}; # Don't delete directories. 286# next if $finfo->{ALTERNATE_VERSIONS}; # Don't delete repository info. 287# next if exists $finfo->{xPHONY}; 288# next if $finfo->{ADDITIONAL_DEPENDENCIES}; # Don't forget info about 289# # extra dependencies, either. 290# next if $finfo->{TRIGGERED_WILD}; # We can't delete it if reading it back 291# # in will trigger a wildcard routine again. 292# if ($fname eq 'all') { 293# warn("I'm deleting all now!!!\n"); 294# } 295# push @deletable, $fname; # No reason to keep this finfo structure 296# # around. (Can't delete it, though, while 297# # we're in the middle of iterating.) 298# } 299# if (@deletable) { # Something to delete? 300# delete @{$dirinfo->{DIRCONTENTS}}{@deletable}; # Get rid of all the unnecessary Mpp::Files. 301# delete $dirinfo->{READDIR}; # We might need to reread this dir. 302# } 303#} 304 305 306 307=head2 name 308 309 $string = $finfo->name; 310 311Returns the absolute name of the file. Note: other classes have this method 312too, so when you're not sure you have a Mpp::File, better use method syntax. 313 314=cut 315 316*name = \&absolute_filename; 317 318=head2 set_additional_dependencies 319 320 set_additional_dependencies($finfo,$dependency_string, $makefile, $makefile_line); 321 322Indicates that the list of objects in $dependency_string are extra dependencies 323of the file. These dependencies are appended to the list of dependencies 324from the rule to build the file. $makefile and $makefile_line are used only 325when we have to expand the list of dependencies. We can't do this until we 326actually need to make the file, because we might not be able to expand 327wildcards or other things properly. 328 329=cut 330 331sub set_additional_dependencies { 332 my ($finfo, $dependency_string, $makefile, $makefile_line) = @_; 333 334 push @{$finfo->{ADDITIONAL_DEPENDENCIES}}, 335 [$dependency_string, $makefile, $makefile_line]; 336 # Store a copy of this information. 337 publish $finfo, $Mpp::rm_stale_files; 338 # For legacy makefiles, sometimes an idiom like 339 # this is used: 340 # y.tab.c: y.tab.h 341 # y.tab.h: parse.y 342 # yacc -d parse.y 343 # in order to indicate that the yacc command 344 # has two targets. We need to support this 345 # by indicating that files with extra 346 # dependencies are buildable, even if there 347 # isn't an actual rule for them. 348 if( $Mpp::Makefile::rule_include ) { 349 # Via :include we read the compiler generated makefile twice. If #include statements 350 # have been removed, we must not store those from 1st time we read build info. 351 if( $Mpp::Makefile::rule_include == 1 ) { # Initial lecture of possibly obsolete .d file 352 $finfo->{ADDITIONAL_DEPENDENCIES_TEMP} = $#{$finfo->{ADDITIONAL_DEPENDENCIES}}; 353 } elsif( exists $finfo->{ADDITIONAL_DEPENDENCIES_TEMP} ) { 354 splice @{$finfo->{ADDITIONAL_DEPENDENCIES}}, delete $finfo->{ADDITIONAL_DEPENDENCIES_TEMP}, 1; 355 } 356 } 357} 358 359=head2 set_build_info_string 360 361 set_build_info_string($finfo, $key, $value, $key, $value, ...); 362 363Sets the build info string for the given key(s). This can be read back in 364later or on a subsequent build by build_info_string(). 365 366You should call update_build_infos() to flush the build information to disk, 367or else it will never be stored. It's a good idea to call 368update_build_infos() fairly frequently, so that nothing is lost in the case of 369a machine crash or someone killing your program. 370 371=cut 372 373sub set_build_info_string { 374 my( $finfo ) = @_; 375 376 my $binfo = $finfo->{BUILD_INFO} ||= 377 # We haven't loaded the build information? 378 &load_build_info_file || # See if there's a build info file. 379 {}; # If we can't find any build information, 380 # at least cache the failure so we don't try 381 # again. 382 383 my $update; 384 my $i = 1; 385 while ($i < $#_) { 386 my( $key, $val ) = ($_[$i], $_[$i + 1]); 387 $i += 2; 388 die if $key eq 'END'; 389 390 unless( defined $binfo->{$key} && $binfo->{$key} eq $val ) { 391 $update = 1; 392 $binfo->{$key} = $val; 393 } 394 } 395 if( $update ) { 396 undef $finfo->{xUPDATE_BUILD_INFOS}; 397 # Remember that we haven't updated this 398 # file yet. 399 push @build_infos_to_update, $finfo; 400 } 401} 402 403=head2 mark_build_info_for_update 404 405 mark_build_info_for_update( $finfo ); 406 407Marks this build info for update the next time an update is done. You only 408need to call this if you modify the BUILD_INFO hash directly; if you call 409set_build_info_string, it's already handled for you. 410 411=cut 412 413sub mark_build_info_for_update { 414 undef $_[0]{xUPDATE_BUILD_INFOS}; # Remember to update 415 push @build_infos_to_update, $_[0]; 416} 417 418=head2 clear_build_info 419 420 clear_build_info( $finfo ); 421 422Clears the build info strings for all keys. 423The principal reason to do this would be that the file is about to be 424regenerated. 425 426=cut 427sub clear_build_info { 428 $_[0]{BUILD_INFO} = {}; # Clear the build information. 429 430 # Now remove the info file, if any. It's dangerous to leave this for 431 # update_build_infos, because if the timestamp of a regenerated file was 432 # the same and we stop before the build info is re-written, then we could 433 # pick up stale info on the next makepp run. 434 435 CORE::unlink &build_info_fname; # Get rid of bogus file. 436 # TBD: What to do if it's still there (e.g. no directory write privilege)? 437 delete $_[0]{xUPDATE_BUILD_INFOS}; # No need to update at the moment. 438} 439 440=head2 set_rule 441 442 set_rule($finfo, $rule); 443 444Sets a rule for building the specified file. If there is already a rule, 445which rule overrides is determined by the following procedure: 446 447=over 4 448 449=item 1. 450 451A rule that recursively invokes make never overrides any other rule. 452This is a hack necessary to deal with some legacy makefiles which have 453rules for targets that actually invoke the proper rule in some other 454makefile, something which is no longer necessary with makepp. 455 456=item 2. 457 458If either rule is an explicit rule, and not a pattern rule or a backward 459inference rule, then the explicit rule is used. If both rules are 460explicit rules, then this is an error. 461 462Note that a pattern rule which is specified like this: 463 464 %.o: %.c : foreach abc.c def.c ghi.c 465 466where no wildcards are involved is treated as an explicit rule for 467abc.o, def.o, and ghi.o. 468 469=item 3. 470 471A pattern rule overrides a backward inference rule. (This should never 472happen, since backward inference rules should only be generated if no pattern 473rule exists.) 474 475=item 4. 476 477A pattern rule from a "nearer" makefile overrides one from a "farther" 478makefile. Nearness is determined by the length of the relative file 479name of the target compared to the makefile's cwd. 480 481=item 5. 482 483A pattern rule seen later overrides one seen earlier. Thus more specific 484pattern rules should be placed after the more general pattern rules. 485 486=item 6. 487 488A builtin rule is always overridden by any other kind of rule, and never 489overrides anything. 490 491=back 492 493=cut 494 495sub set_rule { 496 return if &dont_build; 497 498 my( $finfo, $rule ) = @_; # Name the arguments. 499 500 unless( defined $rule ) { # Are we simply discarding the rule now to 501 # save memory? (There's no point in keeping 502 # the rule around after we've built the thing.) 503 undef $finfo->{RULE} if exists $finfo->{RULE}; 504 # Just keep a marker around that there used 505 # to be a rule. 506 return; 507 } 508 509 my $rule_is_builtin = ($rule->source =~ /\bmakepp_builtin_rules\.mk:/) and 510 exists $finfo->{xPHONY} and # If we know this is a phony target, don't 511 # ever let a builtin rule attempt to build it. 512 return; 513 514 if( my $oldrule = $finfo->{RULE} ) { # Is there a previous rule? 515 516 if( $oldrule->{LOAD_IDX} < $oldrule->{MAKEFILE}{LOAD_IDX}) { 517 undef $finfo->{RULE}; # If the old rule is from a previous load 518 # of a makefile, discard it without comment. 519 delete $finfo->{BUILD_HANDLE}; # Avoid the warning message below. Also, 520 # if the rule has genuinely changed, we may 521 # need to rebuild. 522 } else { 523 return if $rule_is_builtin; # Never let a builtin rule override a rule in the makefile. 524 if( $oldrule->source !~ /\bmakepp_builtin_rules\.mk:/ ) { # The old rule isn't a builtin rule. 525 Mpp::log RULE_ALT => $rule, $oldrule, $finfo 526 if $Mpp::log_level; 527 528 my $new_rule_recursive = ($rule->{COMMAND_STRING} || '') =~ /\$[({]MAKE[)}]/; 529 my $old_rule_recursive = ($oldrule->{COMMAND_STRING} || '') =~ /\$[({]MAKE[)}]/; 530 # Get whether the rules are recursive. 531 532 if( $new_rule_recursive && !$old_rule_recursive ) { 533 # This rule does not override anything if 534 # it invokes a recursive make. 535 Mpp::log RULE_IGN_MAKE => $rule 536 if $Mpp::log_level; 537 return; 538 } 539 540 if( $old_rule_recursive && !$new_rule_recursive ) { 541 Mpp::log RULE_DISCARD_MAKE => $oldrule 542 if $Mpp::log_level; 543 544 delete $finfo->{BUILD_HANDLE}; 545 # Don't give a warning message about a rule 546 # which was replaced, because it's ok in this 547 # case to use a different rule. 548 } elsif( exists $oldrule->{PATTERN_RULES} ) { 549 # 550 # Apparently both are pattern rules. Figure out which one should override. 551 # 552 if( $rule->{MAKEFILE} != $oldrule->{MAKEFILE} ) { # Compare the cwds 553 # if they are from different makefiles. 554 if( relative_filename( $rule->build_cwd, $finfo->{'..'}, 1 ) < 555 relative_filename( $oldrule->build_cwd, $finfo->{'..'}, 1 )) { 556 Mpp::log RULE_NEARER => $rule 557 if $Mpp::log_level; 558 } else { 559 Mpp::log RULE_NEARER_KEPT => $oldrule 560 if $Mpp::log_level; 561 return; 562 } 563 } elsif( !exists $rule->{PATTERN_RULES} || @{$rule->{PATTERN_RULES}} < @{$oldrule->{PATTERN_RULES}} ) { 564 # If they're from the same makefile, use the 565 # one that has a shorter chain of inference. 566 Mpp::log RULE_SHORTER => $rule 567 if $Mpp::log_level; 568 } elsif( @{$rule->{PATTERN_RULES}} > @{$oldrule->{PATTERN_RULES}} ) { 569 Mpp::log RULE_SHORTER => $oldrule 570 if $Mpp::log_level; 571 return; 572 } else { 573 warn 'rule `', $rule->source, "' produces ", &absolute_filename, 574 " in two different ways\n" 575 if $rule->source eq $oldrule->source; 576 } 577 } elsif( exists $rule->{PATTERN_RULES} ) { # New rule is? 578 Mpp::log RULE_IGN_PATTERN => $rule 579 if $Mpp::log_level; 580 return; 581 } else { 582 warn 'conflicting rules `', $rule->source, "' and `", $oldrule->source, "' for target ", 583 &absolute_filename, "\n" 584 unless exists($rule->{xMULTIPLE_RULES_OK}) && 585 exists($oldrule->{xMULTIPLE_RULES_OK}) && 586 $rule->{COMMAND_STRING} eq $oldrule->{COMMAND_STRING}; 587 # It's not safe to suppress this warning solely because the 588 # command string is the same, because it might expand differently 589 # in different makefiles. But if the rules are marked to allow 590 # this, then we suppress anyway. 591 } 592 } 593 } 594 } 595 596# 597# If we get here, we have decided that the new rule (in $rule) should override 598# the old one (if there is one). 599# 600# $Mpp::log_level and 601# Mpp::print_log(0, $rule, ' applies to target ', $finfo); 602 603 undef $finfo->{xPHONY} # Hack to get past above restriction for xyz -> xyz.exe 604 if Mpp::is_windows && $rule_is_builtin && delete $finfo->{_IS_EXE_PHONY_}; 605 606 if( exists $finfo->{BUILD_HANDLE} && UNIVERSAL::isa $finfo->{RULE}, 'Mpp::Rule' ) { 607 warn 'I became aware of the rule `', $rule->source, 608 "' for target ", &absolute_filename, " after I had already tried to build it\n" 609 unless $rule_is_builtin || exists $rule->{xMULTIPLE_RULES_OK} || UNIVERSAL::isa $rule, 'Mpp::DefaultRule'; 610 } 611 612 $finfo->{RULE} = $rule; # Store the new rule. 613 $finfo->{PATTERN_RULES} = $rule->{PATTERN_RULES} if $rule->{PATTERN_RULES}; 614 # Remember the pattern level, so we can prevent 615 # infinite loops on patterns. This must be 616 # set before calling publish(), or we'll get 617 # infinite recursion. 618 $rule->{LOAD_IDX} = $rule->{MAKEFILE}{LOAD_IDX}; 619 # Remember which makefile load it came from. 620 publish $finfo, $Mpp::rm_stale_files; 621 # Now we can build this file; we might not have been able to before. 622} 623 624=head2 signature 625 626 $str = signature( $fileinfo ) 627 628Returns a signature for this file that can be used to know when the file has 629changed. The signature consists of the file modification time and the file 630size concatenated. 631 632Returns undef if the file doesn't exist. 633 634This signature is used for several purposes: 635 636=over 4 637 638=item * 639 640If this signature changes, then we discard the build info for the file because 641we assume it has changed. 642 643=item * 644 645This is currently the default signature if we are not doing compilation of 646source code. 647 648=back 649 650=cut 651 652sub signature { 653 my $stat = $_[0]{LSTAT}; 654 $stat = &stat_array if !$stat || exists $_[0]{LINK_DEREF}; 655 # Get everything we can get about the file 656 # without actually opening it. 657 !@$stat ? undef : # Undef means file doesn't exist. 658 S_ISDIR( $stat->[STAT_MODE] ) ? 1 : 659 # If this is a directory, the modification time 660 # is meaningless (it's inconsistent across 661 # file systems, and it may change depending 662 # on whether the contents of the directory 663 # has changed), so just return a non-zero 664 # constant. 665 # NOTE: This has to track Mpp/BuildCheck/target_newer.pm, and Mpp/BuildCache.pm 666 # in a couple of places: 667 $stat->[STAT_MTIME] . ',' . $stat->[STAT_SIZE]; 668} 669 670=head2 update_build_infos 671 672 Mpp::File::update_build_infos(); 673 674Flushes our cache of build information to disk. You should call this fairly 675frequently, or else if the machine crashes or some other bad thing happens, 676some build information may be lost. 677 678=cut 679 680sub write_build_info_file { 681 my ($build_info_fname, $build_info) = @_; 682 open my $fh, '>', $build_info_fname or return undef; 683 my $contents = ''; 684 while( my($key, $val) = each %$build_info ) { 685 $val =~ tr/\n/\cC/; # Protect newline. Keys must not have any. 686 # (This does not modify the value inside the BUILD_INFO hash.) 687 $contents .= $key . '=' . $val . "\n"; 688 } 689 # This provides proof that the writing of the build info file was not 690 # interrupted. 691 print $fh $contents . 'END=' or return undef; 692 close($fh) or return undef; 693} 694 695sub update_build_infos { 696 foreach my $finfo (@build_infos_to_update) { 697 next unless exists $finfo->{xUPDATE_BUILD_INFOS}; 698 # Skip if we already updated it. If two 699 # build info strings for the same file are 700 # changed, it can get on the list twice. 701 delete $finfo->{xUPDATE_BUILD_INFOS}; # Do not update it again. 702 if( !in_sandbox( $finfo ) || ($Mpp::virtual_sandbox_flag && !$finfo->{BUILDING}) ) { 703 # If we cached some info about a file outside of our sandbox, then 704 # don't flush the info, but don't write it either, because then we could 705 # have a race with another makepp process. (That's what sandboxing is 706 # all about.) 707 Mpp::log NOT_IN_SANDBOX => $finfo 708 if $Mpp::log_level; 709 next; 710 } 711 712 &mkdir # Make sure the build info subdir exists. 713 ($finfo->{'..'}{DIRCONTENTS}{$build_info_subdir} ||= 714 bless { NAME => $build_info_subdir, '..' => $finfo->{'..'} }); 715 716 my $build_info_fname = absolute_filename_nolink( $finfo->{'..'} ) . 717 "/$build_info_subdir/$finfo->{NAME}.mk"; # Form the name of the build info file. 718 719 my $build_info = $finfo->{BUILD_INFO}; # Access the hash. 720 $build_info->{SIGNATURE} ||= signature( $finfo ); 721 # Make sure we have a valid signature. Use 722 # ||= instead of just = because when we're 723 # called to write the build info for a file 724 # from a repository, the build info is created 725 # before the link to avoid the race condition 726 # where a soft link is created and we are 727 # interrupted before marking it as from a 728 # repository. 729 $build_info->{SIGNATURE} or next; 730 # If the file has been deleted, don't bother 731 # writing the build info stuff. 732 write_build_info_file($build_info_fname, $build_info); 733 # Ignore failure to write. TBD: warn here? 734 } 735 @build_infos_to_update = (); # Clean out the list of files to update. 736} 737END { 738 &update_build_infos; 739 for my $finfo ( values %warned_stale ) { 740 if( is_stale $finfo and file_exists $finfo ) { # After all, it is still stale. 741 Mpp::log DEL_STALE => $finfo 742 if $Mpp::log_level; 743 &unlink( $finfo ); 744 CORE::unlink build_info_fname( $finfo ); 745 } 746 } 747} 748 749=head2 was_built_by_makepp 750 751 $built = was_built_by_makepp( $fileinfo ); 752 753Returns TRUE iff the file was put there by makepp and not since modified. 754 755=cut 756 757sub was_built_by_makepp { 758 defined and return 1 759 for build_info_string $_[0], qw'BUILD_SIGNATURE FROM_REPOSITORY'; 760 if( exists $_[0]{TEMP_BUILD_INFO} ) { 761 defined and return 1 762 for @{$_[0]{TEMP_BUILD_INFO}}{qw'BUILD_SIGNATURE FROM_REPOSITORY'}; 763 } 764 0; 765} 766 767=head2 is_stale 768 769 $stale = is_stale( $fileinfo ); 770 771Returns TRUE iff the file was put there by makepp and not since modified, but 772now there is no rule for it, or it is not from a repository and the only 773rule for it is to get it from a repository. 774 775=cut 776 777# is_stale( $finfo ) 778# Note that load_build_info_file may need to track changes to is_stale. 779sub is_stale { 780 (exists $_[0]{xPHONY} || 781 !exists($_[0]{RULE}) && !$_[0]{ADDITIONAL_DEPENDENCIES} 782 ) && !&dont_build && &was_built_by_makepp && 783 (defined &Mpp::Repository::no_valid_alt_versions ? &Mpp::Repository::no_valid_alt_versions : 1); 784} 785 786=head2 assume_unchanged 787 788Returns TRUE iff the file or directory is assumed to be unchanged. 789A file or directory is assumed to be unchanged if any of its ancestor 790directories are assumed unchanged. 791 792=head2 dont_build 793 794Returns TRUE iff the file or directory is marked for don't build. 795A file or directory is treated as marked for don't build if any of its ancestor 796directories are so marked and the youngest such ancestor is not older than 797the youngest ancestor that is marked for do build. 798 799=head2 in_sandbox 800 801Returns TRUE iff the file or directory is marked for in-sandbox (or if 802sandboxing isn't enabled). 803A file or directory is treated as marked for in-sandbox if any of its ancestor 804directories are so marked and the youngest such ancestor is not older than 805the youngest ancestor that is marked for out-of-sandbox. 806 807=head2 dont_read 808 809Returns TRUE iff the file or directory is marked for don't read. 810A file or directory is treated as marked for don't read if any of its ancestor 811directories are so marked and the youngest such ancestor is not older than 812the youngest ancestor that is marked for do read. 813 814=cut 815 816BEGIN { 817 for( qw(assume_unchanged dont_build in_sandbox~!$Mpp::sandbox_enabled_flag dont_read) ) { 818 my( $fn, $fail ) = split '~'; 819 $fail ||= 'undef'; 820 my $key = uc $fn; 821 eval "sub $fn { 822 exists( \$_[0]{$key} ) ? 823 \$_[0]{$key} : 824 (\$Mpp::${fn}_dir_flag && \$_[0] != \$Mpp::File::root) ? 825 (\$_[0]{$key} = $fn( \$_[0]{'..'} )) : 826 $fail; 827 }"; 828 } 829} 830 831 832############################################################################### 833# 834# Internal subroutines (don't call these): 835# 836 837 838sub build_info_fname { "$_[0]{'..'}{FULLNAME}/$build_info_subdir/$_[0]{NAME}.mk" } 839 840sub grok_build_info_file { 841 my( $fh ) = @_; 842 my %build_info; 843 for( <$fh> ) { # Read another line, localizing $_ (while does not) 844 return unless /(.+?)=(.*)/; # Check the format. 845 return \%build_info if $1 eq 'END'; 846 ($build_info{$1} = $2) =~ 847 tr/\cC\r/\n/d; # Strip out the silly Windows EOLs too. 848 } 849 undef; 850} 851 852# 853# Load a build info file, if it matches the signature on the actual file. 854# Returns undef if this build info file didn't exist or wasn't valid, 855# except if called from mppr, in which case it deletes SIGNATURE. 856# Arguments: 857# a) The Mpp::File struct for the file. 858# 859sub load_build_info_file { 860 my $build_info_fname = &build_info_fname; 861 open my $fh, $build_info_fname or 862 return; 863 864 my $build_info = grok_build_info_file $fh; 865 if( defined $build_info ) { 866 my( $finfo ) = @_; 867 my $sig = &signature || ''; # Calculate the signature for the file, so 868 # we know whether the build info has changed. 869 my $sig_match = ($build_info->{SIGNATURE} || '') eq $sig; 870 871 if( exists $build_info->{FROM_REPOSITORY} ) { 872 # If we linked the file in from a repository, but it was since modified in 873 # the repository, then we need to remove the link to the repository now, 874 # because otherwise we won't remove the link before the target gets built. 875 # Note that this code may need to track changes to is_stale. 876 unless( $sig_match && (Mpp::MAKEPP ? exists $finfo->{ALTERNATE_VERSIONS} : 1) || &dont_build ) { 877 if( &dereference != file_info $build_info->{FROM_REPOSITORY}, $finfo->{'..'} ) { 878 undef $sig_match; # The symlink was modified outside of makepp 879 } elsif( &in_sandbox || !-e &absolute_filename ) { 880 # If the symlink points nowhere, then there is no race here even 881 # if it is out of sandbox, because the result is the same no matter 882 # who wins the race. However, this probably isn't 100% 883 # bulletproof, because some makepp process other than the one that 884 # deletes the file might think that it still exists after it and 885 # its build info file have been removed. That's probably still 886 # better than getting permanently stuck when a repository file is 887 # deleted. 888 Mpp::log REP_OUTDATED => $finfo 889 if $Mpp::log_level; 890 &unlink; 891 } else { 892 warn $Mpp::sandbox_warn_flag ? '' : 'error: ', 893 "Can't remove outdated repository link " . &absolute_filename . " because it's out of my sandbox\n"; 894 die unless $Mpp::sandbox_warn_flag; 895 } 896 } 897 } 898 899 unless( $sig_match ) { # Exists but has the wrong signature? 900 if( !Mpp::MAKEPP && $Mpp::progname =~ /^makepp(?:info|replay)$/ ) { 901 $build_info->{invalidated_SIGNATURE} = 902 delete $build_info->{SIGNATURE}; # Remember to handle this later in makeppreplay. 903 } elsif( $build_info->{SYMLINK} ) { 904 # Signature is that of linked file. The symlink 905 # is checked before possibly rebuilding it. 906 if( $sig or not $Mpp::rm_stale_files || $build_info->{FROM_REPOSITORY} ) { 907 # Link and linkee exist or not supposed to wipe. 908 $build_info->{SIGNATURE} = $sig; 909 $finfo->{TEMP_BUILD_INFO} = $build_info; # Mpp::Rule::execute will pick it up. 910 } else { 911 Mpp::log DEL_STALE => $finfo 912 if $Mpp::log_level; 913 &unlink; 914 CORE::unlink $build_info_fname; 915 } 916 return undef; 917 } else { 918 Mpp::log OUT_OF_DATE => $finfo 919 if $Mpp::log_level; 920 CORE::unlink $build_info_fname; # Get rid of bogus file. 921 # NOTE: We assume that if we failed to unlink $finfo, then we'll fail to 922 # unlink $build_info_fname as well, so that the FROM_REPOSITORY turd will 923 # remain behind, which is what we want. Furthermore, because we remember 924 # that we tried to unlink $finfo, it should appear to makepp that it 925 # no longer exists, which is also what we want. 926 return undef; 927 } 928 } 929 } else { 930 warn "$build_info_fname: build info file corrupted\n"; 931 CORE::unlink $build_info_fname; # Get rid of bogus file. 932 } 933 $build_info; 934} 935 9361; 937