lib/Make.pm - metacpan.org

## no critic
package Make::Rule::Vars;
use strict;
use warnings;

use Carp;

my $generation = 0;    # lexical cross-package scope used!

# Package to handle 'magic' variables pertaining to rules e.g. $@ $* $^ $?
# by using tie to this package 'subsvars' can work with array of
# hash references to possible sources of variable definitions.

sub TIEHASH {
	my ( $class, $rule ) = @_;
	return bless \$rule, $class;
}

sub FETCH {
	my $self = shift;
	local $_ = shift;
	my $rule = $$self;
	return unless (/^[\@^<?*]$/);

	# print STDERR "FETCH $_ for ",$rule->Name,"\n";
	return $rule->Name if ( $_ eq '@' );
	return $rule->Base if ( $_ eq '*' );
	return join( ' ', $rule->exp_depend )  if ( $_ eq '^' );
	return join( ' ', $rule->out_of_date ) if ( $_ eq '?' );

	# Next one is dubious - I think $< is really more subtle ...
	return ( $rule->exp_depend )[0] if ( $_ eq '<' );
	return;
}

## no critic
package Make::Rule;
use strict;
use warnings;

use Carp;

# Bottom level 'rule' package
# An instance exists for each ':' or '::' rule in the makefile.
# The commands and dependancies are kept here.

sub target {
	return shift->{TARGET};
}

sub Name {
	return shift->target->Name;
}

sub Base {
	my $name = shift->target->Name;
	$name =~ s/\.[^.]+$//;
	return $name;
}

sub Info {
	return shift->target->Info;
}

sub depend {
	my $self = shift;
	if (@_) {
		my $name = $self->Name;
		my $dep  = shift;
		confess "dependants $dep are not an array reference" unless ( 'ARRAY' eq ref $dep );
		foreach my $file (@$dep) {
			unless ( exists $self->{DEPHASH}{$file} ) {
				$self->{DEPHASH}{$file} = 1;
				push( @{ $self->{DEPEND} }, $file );
			}
		}
	}
	return (wantarray) ? @{ $self->{DEPEND} } : $self->{DEPEND};
}

sub command {
	my $self = shift;
	if (@_) {
		my $cmd = shift;
		confess "commands $cmd are not an array reference" unless ( 'ARRAY' eq ref $cmd );
		if (@$cmd) {
			if ( @{ $self->{COMMAND} } ) {
				warn "Command for " . $self->Name, " redefined";
				print STDERR "Was:", join( "\n", @{ $self->{COMMAND} } ), "\n";
				print STDERR "Now:", join( "\n", @$cmd ), "\n";
			}
			$self->{COMMAND} = $cmd;
		}
		else {
			if ( @{ $self->{COMMAND} } ) {

				# warn "Command for ".$self->Name," retained";
				# print STDERR "Was:",join("\n",@{$self->{COMMAND}}),"\n";
			}
		}
	}
	return (wantarray) ? @{ $self->{COMMAND} } : $self->{COMMAND};
}

#
# The key make test - is target out-of-date as far as this rule is concerned
# In scalar context - boolean value of 'do we need to apply the rule'
# In list context the things we are out-of-date with e.g. magic $? variable
#
sub out_of_date {
	my $array = wantarray;
	my $self  = shift;
	my $info  = $self->Info;
	my @dep   = ();
	my $tdate = $self->target->date;
	my $count = 0;
	foreach my $dep ( $self->exp_depend ) {

		# This is a dumb fix around regex issues with using Strawberry perl.
		# This may not fix for all versions of Strawberry perl or all versions
		# of windows, but is a hacky work-around until a real fix can be implemented
		if ( $^O eq 'MSWin32' ) {
			if ( $dep =~ m/libConfig.pm/ ) {
				$dep =~ s#libConfig.pm#lib\\Config.pm#;
			}
			if ( $dep =~ m/COREconfig.h/ ) {
				$dep =~ s#COREconfig.h#CORE\\config.h#;
			}
		}
		my $date = $info->date($dep);
		$count++;
		if ( !defined($date) || !defined($tdate) || $date < $tdate ) {

			# warn $self->Name." ood wrt ".$dep."\n";
			return 1 unless $array;
			push( @dep, $dep );
		}
	}
	return @dep if $array;

	# Note special case of no dependencies means it is always  out-of-date!
	return !$count;
}

#
# Return list of things rule depends on with variables expanded
# - May need pathname and vpath processing as well
#
sub exp_depend {
	my $self = shift;
	my $info = $self->Info;
	my @dep  = map( split( /\s+/, $info->subsvars($_) ), $self->depend );
	return (wantarray) ? @dep : \@dep;
}

#
# Return commands to apply rule with variables expanded
# - No pathname processing needed, commands should always chdir()
#   to logical place (at least till we get very clever at bourne shell parsing).
# - May need vpath processing
#
sub exp_command {
	my $self = shift;
	my $info = $self->Info;
	my $base = $self->Name;
	my %var;
	tie %var, 'Make::Rule::Vars', $self;
	my @cmd = map( $info->subsvars( $_, \%var ), $self->command );
	return (wantarray) ? @cmd : \@cmd;
}

#
# clone creates a new rule derived from an existing rule, but
# with a different target. Used when left hand side was a variable.
# perhaps should be used for dot/pattern rule processing too.
#
sub clone {
	my ( $self, $target ) = @_;
	my %hash = %$self;
	$hash{TARGET}  = $target;
	$hash{DEPEND}  = [ @{ $self->{DEPEND} } ];
	$hash{DEPHASH} = { %{ $self->{DEPHASH} } };
	my $obj = bless \%hash, ref $self;
	return $obj;
}

sub new {
	my $class  = shift;
	my $target = shift;
	my $kind   = shift;
	my $self   = bless {
		TARGET  => $target,              # parent target (left hand side)
		KIND    => $kind,                # : or ::
		DEPEND  => [], DEPHASH => {},    # right hand args
		COMMAND => []                    # command(s)
	}, $class;
	$self->depend(shift)  if (@_);
	$self->command(shift) if (@_);
	return $self;
}

#
# This code has to go somewhere but no good home obvious yet.
#  - only applies to ':' rules, but needs top level database
#  - perhaps in ->commands of derived ':' class?
#
sub find_commands {
	my ($self) = @_;
	if ( !@{ $self->{COMMAND} } && @{ $self->{DEPEND} } ) {
		my $info = $self->Info;
		my $name = $self->Name;
		my @dep  = $self->depend;
		my @rule = $info->patrule( $self->Name );
		if (@rule) {
			$self->depend( $rule[0] );
			$self->command( $rule[1] );
		}
	}
}

#
# Spew a shell script to perfom the 'make' e.g. make -n
#
sub Script {
	my $self = shift;
	return unless $self->out_of_date;
	my @cmd = $self->exp_command;
	if (@cmd) {
		my $com = ( $^O eq 'MSWin32' ) ? 'rem ' : '# ';
		print $com, $self->Name, "\n";
		foreach my $file ( $self->exp_command ) {
			$file =~ s/^[\@\s-]*//;
			print "$file\n";
		}
	}
}

#
# Normal 'make' method
#
sub Make {
	my $self = shift;
	my $file;
	return unless ( $self->out_of_date );
	my @cmd  = $self->exp_command;
	my $info = $self->Info;
	if (@cmd) {
		foreach my $file ( $self->exp_command ) {
			$file =~ s/^([\@\s-]*)//;
			my $prefix = $1;
			print "$file\n" unless ( $prefix =~ /\@/ );
			my $code = $info->exec($file);
			if ( $code && $prefix !~ /-/ ) {
				die "Code $code from $file";
			}
		}
	}
}

#
# Print rule out in makefile syntax
# - currently has variables expanded as debugging aid.
# - will eventually become make -p
# - may be useful for writing makefiles from MakeMaker too...
#
sub Print {
	my $self = shift;
	my $file;
	print $self->Name, ' ', $self->{KIND}, ' ';
	foreach my $file ( $self->depend ) {
		print " \\\n   $file";
	}
	print "\n";
	my @cmd = $self->exp_command;
	if (@cmd) {
		foreach my $file ( $self->exp_command ) {
			print "\t", $file, "\n";
		}
	}
	else {
		print STDERR "No commands for ", $self->Name, "\n" unless ( $self->target->phony );
	}
	print "\n";
}

package Make::Target;
use strict;
use warnings;

use Carp;
use Cwd;

#
# Intermediate 'target' package
# There is an instance of this for each 'target' that apears on
# the left hand side of a rule i.e. for each thing that can be made.
#
sub new {
	my ( $class, $info, $target ) = @_;
	return bless {
		NAME     => $target,    # name of thing
		MAKEFILE => $info,      # Makefile context
		Pass     => 0           # Used to determine if 'done' this sweep
	}, $class;
}

sub date {
	my $self = shift;
	my $info = $self->Info;
	return $info->date( $self->Name );
}

sub phony {
	my $self = shift;
	return $self->Info->phony( $self->Name );
}

sub colon {
	my $self = shift;
	if (@_) {
		if ( exists $self->{COLON} ) {
			my $dep = $self->{COLON};
			if ( @_ == 1 ) {

				# merging an existing rule
				my $other = shift;
				$dep->depend( scalar $other->depend );
				$dep->command( scalar $other->command );
			}
			else {
				$dep->depend(shift);
				$dep->command(shift);
			}
		}
		else {
			$self->{COLON} = ( @_ == 1 ) ? shift->clone($self) : Make::Rule->new( $self, ':', @_ );
		}
	}
	if ( exists $self->{COLON} ) {
		return (wantarray) ? ( $self->{COLON} ) : $self->{COLON};
	}
	else {
		return (wantarray) ? () : undef;
	}
}

sub dcolon {
	my $self = shift;
	if (@_) {
		my $rule = ( @_ == 1 ) ? shift->clone($self) : Make::Rule->new( $self, '::', @_ );
		$self->{DCOLON} = [] unless ( exists $self->{DCOLON} );
		push( @{ $self->{DCOLON} }, $rule );
	}
	return ( exists $self->{DCOLON} ) ? @{ $self->{DCOLON} } : ();
}

sub Name {
	return shift->{NAME};
}

sub Info {
	return shift->{MAKEFILE};
}

sub ProcessColon {
	my ($self) = @_;
	my $c = $self->colon;
	$c->find_commands if $c;
}

sub ExpandTarget {
	my ($self) = @_;
	my $target = $self->Name;
	my $info   = $self->Info;
	my $colon  = delete $self->{COLON};
	my $dcolon = delete $self->{DCOLON};
	foreach my $expand ( split( /\s+/, $info->subsvars($target) ) ) {
		next unless defined($expand);
		my $t = $info->Target($expand);
		if ( defined $colon ) {
			$t->colon($colon);
		}
		foreach my $d ( @{$dcolon} ) {
			$t->dcolon($d);
		}
	}
}

sub done {
	my $self = shift;
	my $info = $self->Info;
	my $pass = $info->pass;
	return 1 if ( $self->{Pass} == $pass );
	$self->{Pass} = $pass;
	return 0;
}

sub recurse {
	my ( $self, $method, @args ) = @_;
	my $info = $self->Info;
	my $i    = 0;
	foreach my $rule ( $self->colon, $self->dcolon ) {
		my $j = 0;
		foreach my $dep ( $rule->exp_depend ) {

			# This is a dumb fix around regex issues with using Strawberry perl.
			# This may not fix for all versions of Strawberry perl or all versions
			# of windows, but is a hacky work-around until a real fix can be implemented
			if ( ( $dep =~ m/libConfig.pm/ ) and ( $^O eq 'MSWin32' ) ) {
				print STDERR "we got here with $dep\n";
				$dep =~ s#libConfig.pm#lib//Config.pm#;
			}
			if ( ( $dep =~ m/COREconfig.h/ ) and ( $^O eq 'MSWin32' ) ) {
				print STDERR "we got here with $dep\n";
				$dep =~ s#COREconfig.h#CORE//config.h#;
			}

			my $t = $info->{Depend}{$dep};
			if ( defined $t ) {
				$t->$method(@args);
			}
			else {
				unless ( $info->exists($dep) ) {
					my $dir = cwd();
					die "Cannot recurse $method - no target $dep in $dir";
				}
			}
		}
	}
}

sub Script {
	my $self = shift;
	my $info = $self->Info;
	my $rule = $self->colon;
	return if ( $self->done );
	$self->recurse('Script');
	foreach my $rule ( $self->colon, $self->dcolon ) {
		$rule->Script;
	}
}

sub Make {
	my $self = shift;
	my $info = $self->Info;
	my $rule = $self->colon;
	return if ( $self->done );
	$self->recurse('Make');
	foreach my $rule ( $self->colon, $self->dcolon ) {
		$rule->Make;
	}
}

sub Print {
	my $self = shift;
	my $info = $self->Info;
	return if ( $self->done );
	my $rule = $self->colon;
	foreach my $rule ( $self->colon, $self->dcolon ) {
		$rule->Print;
	}
	$self->recurse('Print');
}

package Make;

use 5.005;    # Need look-behind assertions
use strict;
use warnings;

use Carp;
use Config;
use Cwd;
use File::Spec;
use vars qw($VERSION);
$VERSION = '1.1.2';

my %date;

sub phony {
	my ( $self, $name ) = @_;
	return exists $self->{PHONY}{$name};
}

sub suffixes {
	my ($self) = @_;
	return keys %{ $self->{'SUFFIXES'} };
}

#
# Construct a new 'target' (or find old one)
# - used by parser to add to data structures
#
sub Target {
	my ( $self, $target ) = @_;
	unless ( exists $self->{Depend}{$target} ) {
		my $t = Make::Target->new( $self, $target );
		$self->{Depend}{$target} = $t;
		if ( $target =~ /%/ ) {
			$self->{Pattern}{$target} = $t;
		}
		elsif ( $target =~ /^\./ ) {
			$self->{Dot}{$target} = $t;
		}
		else {
			push( @{ $self->{Targets} }, $t );
		}
	}
	return $self->{Depend}{$target};
}

#
# Utility routine for patching %.o type 'patterns'
#
sub patmatch {
	my $key = shift;
	local $_ = shift;
	my $pat = $key;
	$pat =~ s/\./\\./;
	$pat =~ s/%/(\[^\/\]*)/;
	if (/$pat$/) {
		return $1;
	}
	return;
}

#
# old vpath lookup routine
#
sub locate {
	my $self = shift;
	local $_ = shift;
	return $_ if ( -r $_ );
	foreach my $key ( keys %{ $self->{vpath} } ) {
		my $Pat;
		if ( defined( $Pat = patmatch( $key, $_ ) ) ) {
			foreach my $dir ( split( /:/, $self->{vpath}{$key} ) ) {
				return "$dir/$_" if ( -r "$dir/$_" );
			}
		}
	}
	return;
}

#
# Convert traditional .c.o rules into GNU-like into %o : %c
#
sub dotrules {
	my ($self) = @_;
	foreach my $t ( keys %{ $self->{Dot} } ) {
		my $e = $self->subsvars($t);
		$self->{Dot}{$e} = delete $self->{Dot}{$t} unless ( $t eq $e );
	}
	my (@suffix) = $self->suffixes;
	foreach my $t (@suffix) {
		my $d;
		my $r = delete $self->{Dot}{$t};
		if ( defined $r ) {
			my @rule = ( $r->colon ) ? ( $r->colon->depend ) : ();
			if (@rule) {
				delete $self->{Dot}{ $t->Name };
				print STDERR $t->Name, " has dependants\n";
				push( @{ $self->{Targets} }, $r );
			}
			else {
				# print STDERR "Build \% : \%$t\n";
				$self->Target('%')->dcolon( [ '%' . $t ], scalar $r->colon->command );
			}
		}
		foreach my $d (@suffix) {
			$r = delete $self->{Dot}{ $t . $d };
			if ( defined $r ) {

				# print STDERR "Build \%$d : \%$t\n";
				$self->Target( '%' . $d )->dcolon( [ '%' . $t ], scalar $r->colon->command );
			}
		}
	}
	foreach my $t ( keys %{ $self->{Dot} } ) {
		push( @{ $self->{Targets} }, delete $self->{Dot}{$t} );
	}
}

#
# Return 'full' pathname of name given directory info.
# - may be the place to do vpath stuff ?
#

my %pathname;

sub pathname {
	my ( $self, $name ) = @_;
	my $hash = $self->{'Pathname'};
	unless ( exists $hash->{$name} ) {
		if ( File::Spec->file_name_is_absolute($name) ) {
			$hash->{$name} = $name;
		}
		else {
			$name =~ s,^\./,,;
			$hash->{$name} = File::Spec->catfile( $self->{Dir}, $name );
		}
	}
	return $hash->{$name};

}

#
# Return modified date of name if it exists
#
sub date {
	my ( $self, $name ) = @_;
	my $path = $self->pathname($name);
	unless ( exists $date{$path} ) {
		$date{$path} = -M $path;
	}
	return $date{$path};
}

#
# Check to see if name is a target we can make or an existing
# file - used to see if pattern rules are valid
# - Needs extending to do vpath lookups
#
sub exists {
	my ( $self, $name ) = @_;
	return 1 if ( exists $self->{Depend}{$name} );
	return 1 if defined $self->date($name);

	# print STDERR "$name '$path' does not exist\n";
	return 0;
}

#
# See if we can find a %.o : %.c rule for target
# .c.o rules are already converted to this form
#
sub patrule {
	my ( $self, $target ) = @_;

	# print STDERR "Trying pattern for $target\n";
	foreach my $key ( keys %{ $self->{Pattern} } ) {
		my $Pat;
		if ( defined( $Pat = patmatch( $key, $target ) ) ) {
			my $t = $self->{Pattern}{$key};
			foreach my $rule ( $t->dcolon ) {
				my @dep = $rule->exp_depend;
				if (@dep) {
					my $dep = $dep[0];
					$dep =~ s/%/$Pat/g;

					# print STDERR "Try $target : $dep\n";
					if ( $self->exists($dep) ) {
						foreach (@dep) {
							s/%/$Pat/g;
						}
						return ( \@dep, scalar $rule->command );
					}
				}
			}
		}
	}
	return ();
}

#
# Old code to handle vpath stuff - not used yet
#
sub needs {
	my ( $self, $target ) = @_;
	unless ( $self->{Done}{$target} ) {
		if ( exists $self->{Depend}{$target} ) {
			my @depend = split( /\s+/, $self->subsvars( $self->{Depend}{$target} ) );
			foreach (@depend) {
				$self->needs($_);
			}
		}
		else {
			my $vtarget = $self->locate($target);
			if ( defined $vtarget ) {
				$self->{Need}{$vtarget} = $target;
			}
			else {
				$self->{Need}{$target} = $target;
			}
		}
	}
}

#
# Substitute $(xxxx) and $x style variable references
# - should handle ${xxx} as well
# - recurses till they all go rather than doing one level,
#   which may need fixing
#
sub subsvars {
	my $self = shift;
	local $_ = shift;
	my @var = @_;
	push( @var, $self->{Override}, $self->{Vars}, \%ENV );
	croak("Trying to subsitute undef value") unless ( defined $_ );
	while ( /(?<!\$)\$\(([^()]+)\)/ || /(?<!\$)\$([<\@^?*])/ ) {
		my ( $key, $head, $tail ) = ( $1, $`, $' );
		my $value;
		if ( $key =~ /^([\w._]+|\S)(?::(.*))?$/ ) {
			my ( $var, $op ) = ( $1, $2 );
			foreach my $hash (@var) {
				$value = $hash->{$var};
				if ( defined $value ) {
					last;
				}
			}
			unless ( defined $value ) {
				die "$var not defined in '$_'" unless ( length($var) > 1 );
				$value = '';
			}
			if ( defined $op ) {
				if ( $op =~ /^s(.).*\1.*\1/ ) {
					local $_ = $self->subsvars($value);
					$op =~ s/\\/\\\\/g;
					next unless $op;

					#I'm not sure what purpose this eval served, and it
					#creates some warnings. Removing until I know a good
					#reason for it's existence.
					#eval { $op . 'g' };
					$value = $_;
				}
				else {
					die "$var:$op = '$value'\n";
				}
			}
		}
		elsif ( $key =~ /wildcard\s*(.*)$/ ) {
			$value = join( ' ', glob( $self->pathname($1) ) );
		}
		elsif ( $key =~ /shell\s*(.*)$/ ) {
			$value = join( ' ', split( '\n', `$1` ) );
		}
		elsif ( $key =~ /addprefix\s*([^,]*),(.*)$/ ) {
			$value = join( ' ', map( $1 . $_, split( '\s+', $2 ) ) );
		}
		elsif ( $key =~ /notdir\s*(.*)$/ ) {
			my @files = split( /\s+/, $1 );
			foreach (@files) {
				s#^.*/([^/]*)$#$1#;
			}
			$value = join( ' ', @files );
		}
		elsif ( $key =~ /dir\s*(.*)$/ ) {
			my @files = split( /\s+/, $1 );
			foreach (@files) {
				s#^(.*)/[^/]*$#$1#;
			}
			$value = join( ' ', @files );
		}
		elsif ( $key =~ /^subst\s+([^,]*),([^,]*),(.*)$/ ) {
			my ( $a, $b ) = ( $1, $2 );
			$value = $3;
			$a =~ s/\./\\./;
			$value =~ s/$a/$b/;
		}

		# ($mktmp) appears to be a dmake only macro
		# its not yet clear to me just how temporary this temporary
		# file is expected to be, but hopefully we can replace this
		# with Path::Tiny->tempfile or the use of File::Temp directly
		# this also only handles one use of the macro, where the content
		# and filename are provided together. they may be provided
		# separately, which I don't think we handle yet
		elsif ( $key =~ /^mktmp,(\S+)\s*(.*)$/ ) {
			my ( $file, $content ) = ( $1, $2 );
			open( my $tmp, ">", $file ) or die "Cannot open $file: $!";
			$content =~ s/\\n//g;
			print TMP $content;
			close(TMP);

			# will have to see if we really want to return the filename
			# here, or if returning the filehandle is the right thing to do
			$value = $file;
		}
		else {
			warn "Cannot evaluate '$key' in '$_'\n";
		}
		$_ = "$head$value$tail";
	}
	s/\$\$/\$/g;
	return $_;
}

#
# Split a string into tokens - like split(/\s+/,...) but handling
# $(keyword ...) with embedded \s
# Perhaps should also understand "..." and '...' ?
#
sub tokenize {
	local $_ = $_[0];
	my @result = ();
	s/\s+$//;
	while ( length($_) ) {
		s/^\s+//;
		last unless (/^\S/);
		my $token = "";
		while (/^\S/) {
			if (s/^\$([\(\{])//) {
				$token .= $&;
				my $paren = $1 eq '(';
				my $brace = $1 eq '{';
				my $count = 1;
				while ( length($_) && ( $paren || $brace ) ) {
					s/^.//;
					$token .= $&;
					$paren += ( $& eq '(' );
					$paren -= ( $& eq ')' );
					$brace += ( $& eq '{' );
					$brace -= ( $& eq '}' );
				}
				die "Mismatched {} in $_[0]" if ($brace);
				die "Mismatched () in $_[0]" if ($paren);
			}
			elsif (s/^(\$\S?|[^\s\$]+)//) {
				$token .= $&;
			}
		}
		push( @result, $token );
	}
	return (wantarray) ? @result : \@result;
}

#
# read makefile (or fragment of one) either as a result
# of a command line, or an 'include' in another makefile.
#
sub makefile {
	my ( $self, $makefile, $name ) = @_;
	local $_;
	print STDERR "Reading $name\n";
Makefile:
	while (<$makefile>) {
		last unless ( defined $_ );
		chomp($_);
		if (/\\$/) {
			chop($_);
			s/\s*$//;
			my $more = <$makefile>;
			$more =~ s/^\s*/ /;
			$_ .= $more;
			redo;
		}
		next if (/^\s*#/);
		next if (/^\s*$/);
		s/#.*$//;
		s/^\s+//;
		if (/^(-?)include\s+(.*)$/) {
			my $opt = $1;
			foreach my $file ( tokenize( $self->subsvars($2) ) ) {
				my $path = $self->pathname($file);
				if ( open( my $mf, "<", $path ) ) {
					$self->makefile( $mf, $path );
					close($mf);
				}
				else {
					warn "Cannot open $path: $!" unless ( $opt eq '-' );
				}
			}
		}
		elsif (/^\s*([\w._]+)\s*:?=\s*(.*)$/) {
			$self->{Vars}{$1} = ( defined $2 ) ? $2 : "";

			#    print STDERR "$1 = ",$self->{Vars}{$1},"\n";
		}
		elsif (/^vpath\s+(\S+)\s+(.*)$/) {
			my ( $pat, $path ) = ( $1, $2 );
			$self->{Vpath}{$pat} = $path;
		}
		elsif (/^\s*([^:]*)(::?)\s*(.*)$/) {
			my ( $target, $kind, $depend ) = ( $1, $2, $3 );
			my @cmnds;
			if ( $depend =~ /^([^;]*);(.*)$/ ) {
				( $depend, $cmnds[0] ) = ( $1, $2 );
			}
			while (<$makefile>) {
				next if (/^\s*#/);
				next if (/^\s*$/);
				last unless (/^\t/);
				chop($_);
				if (/\\$/) {
					chop($_);
					$_ .= ' ';
					$_ .= <$makefile>;
					redo;
				}
				next if (/^\s*$/);
				s/^\s+//;
				push( @cmnds, $_ );
			}
			$depend =~ s/\s\s+/ /;
			$target =~ s/\s\s+/ /;
			my @depend = tokenize($depend);
			foreach ( tokenize($target) ) {
				my $t     = $self->Target($_);
				my $index = 0;
				if ( $kind eq '::' || /%/ ) {
					$t->dcolon( \@depend, \@cmnds );
				}
				else {
					$t->colon( \@depend, \@cmnds );
				}
			}
			redo Makefile;
		}
		else {
			warn "Ignore '$_'\n";
		}
	}
}

sub pseudos {
	my $self = shift;
	foreach my $key (qw(SUFFIXES PHONY PRECIOUS PARALLEL)) {
		my $t = delete $self->{Dot}{ '.' . $key };
		if ( defined $t ) {
			$self->{$key} = {};
			foreach my $dep ( $t->colon->exp_depend ) {
				$self->{$key}{$dep} = 1;
			}
		}
	}
}

sub ExpandTarget {
	my $self = shift;
	foreach my $t ( @{ $self->{'Targets'} } ) {
		$t->ExpandTarget;
	}
	foreach my $t ( @{ $self->{'Targets'} } ) {
		$t->ProcessColon;
	}
}

sub parse {
	my ( $self, $file ) = @_;
	if ( defined $file ) {
		$file = $self->pathname($file);
	}
	else {
		my @files = qw(makefile Makefile);
		unshift( @files, 'GNUmakefile' ) if ( $self->{GNU} );
		foreach my $name (@files) {
			$file = $self->pathname($name);
			if ( -r $file ) {
				$self->{Makefile} = $name;
				last;
			}
		}
	}
	open( my $mf, "<", $file ) or croak("Cannot open $file: $!");
	$self->makefile( $mf, $file );
	close($mf);

	# Next bits should really be done 'lazy' on need.

	$self->pseudos;     # Pull out .SUFFIXES etc.
	$self->dotrules;    # Convert .c.o into %.o : %.c
}

sub PrintVars {
	my $self = shift;
	local $_;
	foreach ( keys %{ $self->{Vars} } ) {
		print "$_ = ", $self->{Vars}{$_}, "\n";
	}
	print "\n";
}

sub exec {
	my $self = shift;
	undef %date;
	$generation++;
	if ( $^O eq 'MSWin32' ) {
		my $cwd = cwd();
		my $ret;
		chdir $self->{Dir};
		$ret = system(@_);
		chdir $cwd;
		return $ret;
	}
	else {
		my $pid = fork;
		if ($pid) {
			waitpid $pid, 0;
			return $?;
		}
		else {
			my $dir = $self->{Dir};
			chdir($dir) || die "Cannot cd to $dir";

			# handle leading VAR=value here ?
			# To handle trivial cases like ': libpTk.a' force using /bin/sh
			exec( "/bin/sh", "-c", @_ ) || confess "Cannot exec " . join( ' ', @_ );
		}
	}
}

sub NextPass { shift->{Pass}++ }
sub pass     { shift->{Pass} }

sub apply {
	my $self   = shift;
	my $method = shift;
	$self->NextPass;
	my @targets = ();

	# print STDERR join(' ',Apply => $method,@_),"\n";
	foreach (@_) {
		if (/^(\w+)=(.*)$/) {

			# print STDERR "OVERRIDE: $1 = $2\n";
			$self->{Override}{$1} = $2;
		}
		else {
			push( @targets, $_ );
		}
	}
	#
	# This expansion is dubious as it alters the database
	# as a function of current values of Override.
	#
	$self->ExpandTarget;    # Process $(VAR) :
	@targets = ( $self->{'Targets'}[0] )->Name unless (@targets);

	# print STDERR join(' ',Targets => $method,map($_->Name,@targets)),"\n";
	foreach (@targets) {
		my $t = $self->{Depend}{$_};
		unless ( defined $t ) {
			print STDERR join( ' ', $method, @_ ), "\n";
			die "Cannot `$method' - no target $_";
		}
		$t->$method();
	}
}

sub Script {
	shift->apply( Script => @_ );
}

sub Print {
	shift->apply( Print => @_ );
}

sub Make {
	shift->apply( Make => @_ );
}

sub new {
	my ( $class, %args ) = @_;
	unless ( defined $args{Dir} ) {
		chomp( $args{Dir} = getcwd() );
	}
	my $self = bless {
		%args,
		Pattern  => {},    # GNU style %.o : %.c
		Dot      => {},    # Trad style .c.o
		Vpath    => {},    # vpath %.c info
		Vars     => {},    # Variables defined in makefile
		Depend   => {},    # hash of targets
		Targets  => [],    # ordered version so we can find 1st one
		Pass     => 0,     # incremented each sweep
		Pathname => {},    # cache of expanded names
		Need     => {},
		Done     => {},
	}, $class;
	$self->{Vars}{CC}     = $Config{cc};
	$self->{Vars}{AR}     = $Config{ar};
	$self->{Vars}{CFLAGS} = $Config{optimize};
	$self->makefile( \*DATA, __FILE__ );
	$self->parse( $self->{Makefile} );
	return $self;
}

=head1 NAME

Make - module for processing makefiles

=head1 SYNOPSIS

	require Make;
	my $make = Make->new(...);
	$make->parse($file);
	$make->Script(@ARGV)
	$make->Make(@ARGV)
	$make->Print(@ARGV)

        my $targ = $make->Target($name);
        $targ->colon([dependancy...],[command...]);
        $targ->dolon([dependancy...],[command...]);
        my @depends  = $targ->colon->depend;
        my @commands = $targ->colon->command;

=head1 DESCRIPTION

Make->new creates an object if C<new(Makefile =E<gt> $file)> is specified
then it is parsed. If not the usual makefile Makefile sequence is
used. (If GNU => 1 is passed to new then GNUmakefile is looked for first.)

C<$make-E<gt>Make(target...)> 'makes' the target(s) specified
(or the first 'real' target in the makefile).

C<$make-E<gt>Print> can be used to 'print' to current C<select>'ed stream
a form of the makefile with all variables expanded.

C<$make-E<gt>Script(target...)> can be used to 'print' to
current C<select>'ed stream the equivalent bourne shell script
that a make would perform i.e. the output of C<make -n>.

There are other methods (used by parse) which can be used to add and
manipulate targets and their dependants. There is a hierarchy of classes
which is still evolving. These classes and their methods will be documented when
they are a little more stable.

The syntax of makefile accepted is reasonably generic, but I have not re-read
any documentation yet, rather I have implemented my own mental model of how
make works (then fixed it...).

In addition to traditional

	.c.o :
		$(CC) -c ...

GNU make's 'pattern' rules e.g.

	%.o : %.c
		$(CC) -c ...

Likewise a subset of GNU makes $(function arg...) syntax is supported.

Via pmake Make has built perl/Tk from the C<MakeMaker> generated Makefiles...

=head1 BUGS

At present C<new> must always find a makefile, and
C<$make-E<gt>parse($file)> can only be used to augment that file.

More attention needs to be given to using the package to I<write> makefiles.

The rules for matching 'dot rules' e.g. .c.o   and/or pattern rules e.g. %.o : %.c
are suspect. For example give a choice of .xs.o vs .xs.c + .c.o behaviour
seems a little odd.

Variables are probably substituted in different 'phases' of the process
than in make(1) (or even GNU make), so 'clever' uses will probably not
work.

UNIXisms abound.

=head1 SEE ALSO

L<pmake>

=head1 AUTHOR

Nick Ing-Simmons

=cut

1;
#
# Remainder of file is in makefile syntax and constitutes
# the built in rules
#
__DATA__

.SUFFIXES: .o .c .y .h .sh .cps

.c.o :
	$(CC) $(CFLAGS) $(CPPFLAGS) -c -o $@ $<

.c   :
	$(CC) $(CFLAGS) $(CPPFLAGS) -o $@ $< $(LDFLAGS) $(LDLIBS)

.y.o:
	$(YACC) $<
	$(CC) $(CFLAGS) $(CPPFLAGS) -c -o $@ y.tab.c
	$(RM) y.tab.c

.y.c:
	$(YACC) $<
	mv y.tab.c $@
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)