view release on metacpan or  search on metacpan

Mpp/File.pm  view on Meta::CPAN

				# directories for performance reasons.
  my $parent = '..';		# Ensure we cache all upwards paths.
  for( my $pinfo = $_[0]{'..'}; !exists $pinfo->{xABSOLUTE}; $pinfo = $pinfo->{'..'} ) {
    $_[0]{sprintf '%x', $pinfo} = $parent;
    $parent .= '/..';
  }
}

#
# Subroutine to activate any wildcard routines which might be waiting to hear
# about this file.  This subroutine is called whenever a file might possibly
# be new.
#
# In order to allow wildcard subroutines to be run on files created during
# execution, and not just on files which existed when the wildcard was
# first seen, we store up a subroutines in each directory to be activated
# when a new file matches a given pattern.  This subroutine is responsible for
# activating them.
#
# A file will be published even if it's been published before if $level
# (default 0) is greater than the level with which it was previously published.
# Makepp uses this to implement --rm-stale, because a file needs to be
# re-published if it looked like a stale file the last time it was published,
# but a rule for the file was learned.
#
sub publish {
  #my( $finfo, $level ) = @_;
  return if exists $_[0]{PUBLISHED} && $_[0]{PUBLISHED} > ($_[1] || 0);
				# Don't do anything if we already published
				# this file.
  my( $finfo ) = @_;
  $finfo->{PUBLISHED} = ($_[1] || 0) + 1;

  my $fname = $finfo->{NAME};	# Form the relative filename.
  my $dirinfo = $finfo->{'..'};	# Find the directory that contains it.
  my $leaf = 1;
  my $stale;

  while ($dirinfo) {		# Go until we hit the top level.
    for my $arr ( @{$dirinfo->{WILDCARD_DO}} ) {
				# Check each wildcard match specified to start
				# in this directory.
      # my( $re, $wild_rtn, $deep, $need_dir ) = @$arr;
      next unless $leaf || $arr->[2];
      next if $fname !~ $arr->[0];
      next if $arr->[3] && !is_or_will_be_dir $finfo;
      if( $Mpp::rm_stale_files ) {
	$stale = &is_stale unless defined $stale;
	next if $stale;
	$finfo->{PUBLISHED} = 2;
      }
      $arr->[1]( $finfo );	# Call the wildcard action routine if it matches.
    }

    substr $fname, 0, 0, $dirinfo->{NAME} . '/';
				# Form the relative filename of the next level.
    $dirinfo = $dirinfo->{'..'}; # Go up a level.
    undef $leaf;
  }
}
$ENV{HOME} ||= (Mpp::is_windows > 0 ? $ENV{USERPROFILE} : eval { (getpwuid $>)[7] }) || '.';
# Make sure we notice a symbolic name for the home directory, and switch to absolute name when going above it
undef dereference( file_info "$ENV{HOME}/" )->{'..'}{xABSOLUTE};

1;


__END__

Here is a review of which functions are safe to call as &fn, i.e. reusing your
own stack.  This is to make sure that no problem arises if the calling
function may itself have been called with more arguments.  Therefore functions
with a variable number of arguments should be called with an explicit
parameter list.  That way the calling function doesn't inherit the weakness of
a varying list.  The function name can be evited, calling either
absolute_filename or relative_filename with 2 args.

Primary functions, i.e. which call no others as &fn, so extra args are ok,
unless there are optional args:

absolute_filename (1 arg)
absolute_filename_nolink (1 arg)
assume_unchanged (1 arg)
build_info_fname (1 arg)
dont_build (1 arg)
dont_read (1 arg)
in_sandbox (1 arg)
mark_build_info_for_update (1 arg)
may_have_changed (1 arg)
parent (1 arg)
publish (1 or 2 args)
touched_filesystem (0 args)
update_build_infos (0 args)

Secondary functions, which have been checked to hand down no further args, no
matter how many extra args get passed in:

check_for_change (1 arg)
dereference (1 arg)
dir_stat_array (1 arg)
file_exists (1 arg)
have_read_permission (1 arg)
is_dir (1 arg)
is_or_will_be_dir (1 arg)
is_stale (1 arg)
is_symbolic_link (1 arg)
is_writable_owner (1 arg)
load_build_info_file (1 arg)
lstat_array (1 arg)
mark_as_directory (1 arg)
mkdir (1 arg)
name (1 or 2 args)
read_directory (1 arg)
relative_filename (1 to 3 args)
signature (1 arg)
stat_array (1 arg)
unlink (1 arg)
was_built_by_makepp (1 arg)

=head1 AUTHOR