/usr/local/CPAN/makepp/RecursiveMake.pm

package RecursiveMake
EOF
# $Id: RecursiveMake.pm,v 1.1 2008/06/01 21:55:24 pfeiffer Exp $
#
# This file groups all the functions needed only if repositories are actually used.
# The actual functionality is also dispersed in makepp and other modules.
#

package RecursiveMake;

use FileInfo;
use TextSubs;
use MakeEvent qw(wait_for read_wait);

our $traditional;		# 1 if we invoke makepp recursively, undef if
				# we call the recursive_makepp stub and do
				# the build in the parent process.

#
# Set up our socket for listening to recursive make requests.  We don't do
# this unless we actually detect the use of the $(MAKE) variable.
#
our( $socket, $socket_name );
sub setup_socket {
  return if $socket_name; # Don't do anything if we've already
				# made the socket.
#
# Get a temp name that goes away at the end, so we don't clutter up /tmp.
#
  $socket_name = Makesubs::f_mktemp '/tmp/makepp.';
				# Name of socket for listening to recursive
				# make requests.  This is exported to the
				# environment by Rule::execute.
  require IO::Socket;
  $socket =
    IO::Socket::UNIX->new(Local => $socket_name,
			  Type => eval 'use IO::Socket; SOCK_STREAM',
			  Listen => 2) or
				# Make the socket.
    die "$progname: can't create socket $socket_name\n";
  chmod 0600, $socket_name;
				# Don't let other people access it.
  read_wait $socket, \&connection;
}


#
# This subroutine is called whenever a connection is made to the recursive
# make socket.
#
sub connection {
  my $connected_socket = $_[0]->accept(); # Make the connection.
  return unless $connected_socket; # Skip failed accepts.  I guess this might
				# happen if the other process has already
				# exited.
#
# Set up a few data items about this stream.  These will be passed thruogh
# the closure to the actual read routine.
#
  my $whole_command = '';	# Where we accumulate the whole command
				# from the recursive make process.
  my $read_sub;
  $read_sub = sub {
#
# This subroutine is called whenever we get a line of text through our
# recursive make socket.
    my $fh = $_[0];		# Access the file handle.
    my $line;
    if (sysread($fh, $line, 8192) == 0) {	# Try to read.
      $fh->close;		# If we got 0 bytes, it means the other end
				# closed the socket.
      return;
    }
    $whole_command .= $line;	# Append the line.
    if ($whole_command =~ s/^(.*)\01END\01//s) {
				# Do we have the whole command
				# now?
      my @lines = split(/\n/, $1); # Access each of the pieces.
      my @words = unquote_split_on_whitespace shift @lines;
				# First one is the set of arguments to
				# parse_command.
      my %this_ENV;		# Remaining lines are environment variables.
      foreach (@lines) {
	if( s/^([^=]+)=// ) {	# Correct format?
	  $this_ENV{$1} = unquote $_; # Store it.
	} else {
	  die "illegal command received from recursive make process:\n$_\n";
	}
      }
#
# We've now got all of the environment and command words.  Start executing
# them.
#
      chdir shift @words;	# Move to the appropriate directory.
      MakeEvent::Process::adjust_max_processes(1); # Allow one more process to
				# run simultaneously.
      my $status;
      eval {
	local @ARGV = @words;
        $status = wait_for ::parse_command_line %this_ENV;
				# Build all the targets.
      };
      MakeEvent::Process::adjust_max_processes(-1); # Undo our increment above.
      my $msg = $@;
      if ($msg) {               # Some error occured that caused a die?
        $status ||= 1;          # Force an error code.
      }
      print $fh ($status || '0') . " $msg";
				# Send the result to the recursive make
				# process.
      close $fh;                # Force a close immediately.
    }
    else {
      read_wait $fh, $read_sub;	# Prepare to read another line.
    }
  };

  read_wait $connected_socket, $read_sub; # Start the initial read.
  read_wait $_[0], \&connection; # Requeue listening.
}

#
# This is the actual function which overloads the stub.
#
no warnings 'redefine';

#
# $(MAKE) needs to expand to the name of the program we use to replace a
# recursive make invocation.  We pretend it's a function with no arguments.
#
our $command;			# Once this is set, we know we can potentially have recursion.
sub Makesubs::f_MAKE {
  if( defined $traditional ) {	# Do it the bozo way?
    unless( defined $command ) { # Haven't figured it out yet?
      $command = $0;		# Get the name of the program.
      unless( $command =~ m@^/@ ) { # Not absolute?
#
# We have to search the path to figure out where we came from.
#
	foreach( TextSubs::split_path(), '.' ) {
	  my $finfo = file_info "$_/$0", $::original_cwd;
	  if( file_exists $finfo ) { # Is this our file?
	    $command = FileInfo::absolute_filename $finfo;
	    last;
	  }
	}
      }
    }
    ::PERL . ' ' . $command . ' --recursive_makepp';
				# All the rest of the info is passed in the
				# MAKEFLAGS environment variable.
				# The --recursive option is just a flag that
				# helps the build subroutine identify this as
				# a recursive make command.  It doesn't
				# actually do anything.
  } else {
    die "makepp: recursive make without --traditional-recursive-make only supported on Cygwin Perl\n"
      if ::is_windows < -1 || ::is_windows > 0;

    my $makefile = $_[1];	# Get the makefile we're run from.

    $command ||= ::PERL . ' ' .
      FileInfo::absolute_filename( file_info $::datadir, $::original_cwd ) .
	'/recursive_makepp';
				# Sometimes we can be run as ../makepp, and
				# if we didn't hard code the paths into
				# makepp, the directories may be relative.
				# However, since recursive make is usually
				# invoked in a separate directory, the
				# path must be absolute.
    $makefile->cleanup_vars;
    join ' ', $command,
      map { "$_=" . requote $makefile->{COMMAND_LINE_VARS}{$_} } keys %{$makefile->{COMMAND_LINE_VARS}};
  }
}

1;