#!/usr/bin/perl -w

# Copyright 2013 Stefan Merten

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Based on: Id: sample.pl,v 4.1.1.2 2007/06/25 12:43:36 cvs Exp

=head1 NAME

make3_80-sh - Executes commands written for GNU make V3.80

=head1 SYNOPSIS

B<make3_80-sh> [options] -- B<-c> I<command>

B<make3_80-sh> B<-H>

=head1 DESCRIPTION

In order to comply with POSIX GNU B<make> V3.81 introduced a change in how
backslash-newline combinations in commands are handled. Whereas up to GNU
B<make> V3.80 backslash-newlines are removed from a command line, GNU B<make>
V3.81 preserves backslash-newlines giving them to the shell.

If you have a I<Makefile> written for GNU B<make> <= V3.80 then this may
contain backslash-newlines which are unexcpected when executed by GNU B<make>
V3.81.

Consider the following example:

  ok:
          echo first ; \
          echo second

In V3.80 the shell sees

  echo first ; echo second

In V3.81 the shell sees

  echo first ; \
  echo second

This example is not a problem because the shell interprets the
backslash-newline correctly.

In the next example, however, the semantic of the command is changed:

  fail:
          echo 'first\n\
          second'

In V3.80 the shell sees

  echo 'first\nsecond'

In V3.81 the shell sees

  echo 'first\n\
  second'

Because the backslash-newline is part of a quoted string the shell takes it
literally and adds another line to the output.

This effect is heavy for longer B<perl> scripts because they see the
backslash-newlines and cannot interpret them correctly. This affects older
I<Makefile>s which may be hard to do.

B<make3_80-sh> is a drop-in replacement solving this problem. Just put it in
the B<SHELL> variable of B<make> and continue to use your I<Makefile>s written
for GNU B<make> <= V3.80 with GNU B<make> >= V3.81.

=head2 Migration

Apart from the solving the problem with old I<Makefile>s B<make3_80-sh> also
works as a migration aid. You can mix commands written for GNU B<make> <= V3.80
with commands written for GNU B<make> >= V3.81. To preserve backslash-newlines
as V3.81 does just put the string C<3.81> somewhere before the first
backslash-newline.

An example for a shell command:

  for3_81:
	  : "This command is written for GNU make V3.81" ; \
          do_something_useful

Or for a Perl command:

  for3_81:
          perl -e '"This command is written for GNU make V3.81" ; # \
          do_something_useful

When executed under GNU B<make> <= V3.80 the backslash-newlines are removed
probably modifying the intended semantic (see L<"BUGS">). Thus when
B<make3_80-sh> encounters a marked line and finds no backslash-newlines it
emits a warning.

See also option B<-m/--migrate> for more migration options.

=cut

###############################################################################

require 5.004;

# Switch warning on
$^W = 1;

use strict;
use diagnostics;

use Getopt::Long qw( GetOptions GetOptionsFromArray );
use Carp qw( carp croak confess );

use FindBin;

{
  local %ENV = ( POSIXLY_CORRECT => 1 );
  Getopt::Long::config("default", "bundling");
}

sub errEx($@);

###############################################################################
###############################################################################
# Constants

my $DfltSh = "/bin/sh";

my $OptC = "-c";

my $MetaCharsRE = qr'[]["#$&()*;<>?^`~]';

my $FirstLineMarkerRE = qr"\Q3.81";

my $EnvOpts = "MAKE3_80_SH_OPTIONS";

my $MigQuiet = "quiet";
my $MigWarn = "warn";
my $MigError = "error";
my $MigInfo = "info";
my @MigModes = ( $MigQuiet, $MigWarn, $MigError, $MigInfo );
my $DfltMig = $MigQuiet;

###############################################################################
###############################################################################
# Options

my %OptS2OptVar;
my $SUsage = "Usage: $FindBin::Script";

=head1 OPTIONS

=over 4

=item B<-c> I<command>

This is not really an option but the way B<make> hands the command down to the
shell. It must appear last on the command line and in exactly this form.

=cut

=item B<-m> I<migration-mode>

=item B<--migrate=>I<migration-mode>

Give hints for migrating a I<Makefile> written for GNU B<make> <= V3.80 to GNU
B<make> >= V3.81. I<migration-mode> may have one of the following values:

=over 4

=item C<quiet>

Don't give any migration hints.

=item C<warn>

If B<make3_80-sh> notices backslash-newline in a command which is not marked by
C<3.81> in the first line a warning is generated on stderr.

This is a hint that this command probably needs to be migrated to V3.81.

=item C<error>

Works as C<warn> but exits with an error probably stopping the calling B<make>.

=item C<info>

Warn about commands with a C<3.81> in the first line.

This is a tool to finish a migration and helps to find places where the marker
is which should be removed.

=back

Defaults to C<quiet>.

=cut

my $migrate = $DfltMig;
$OptS2OptVar{"m|migrate=s"} = \$migrate;
$SUsage .= " [-m <migration-mode>]";

=item B<-s> I<shell>

=item B<--shell=>I<shell>

Shell to execute. I<shell> is split at whitespace. This way options may be
given. There is no way to quote such whitespace.

Defaults to B</bin/sh>.

=cut

my $shell = $DfltSh;
$OptS2OptVar{"s|shell=s"} = \$shell;
$SUsage .= " [-s <shell>]";

=item B<-v>

=item B<--verbose>

Operate verbose. This is mainly for debugging purposes.

=cut

my $verb = 0;
$OptS2OptVar{"v|verbose"} = \$verb;
$SUsage .= " [-v]";

=item B<-H>

=item B<--help>

Generate the man page for this program on standard output.

=cut

my $help = 0;
$OptS2OptVar{"H|help"} = \$help;
$SUsage .= " [-H]";

=back

If an unknown option such as B<-.> is given, a short usage message is
generated.

=cut

$SUsage .= " -- -c <command>";

# Options and usage
errEx(1, $SUsage)
    unless GetOptions(%OptS2OptVar);

if($ENV{$EnvOpts}) {
  my @argv;
  for(my( $append, $suf, $pre, $ch ) = ( 0, $ENV{$EnvOpts} ); ; ) {
    $suf =~ s/^\s+// # Remove leading, unquoted whitespace from next word
	unless $append;

    $suf =~ /^([^\s\\]*)([\s\\]|$)/;
    ( $pre, $ch, $suf ) = ( $1, $2, $' );
    last # Nothing left
	unless $pre || $suf;
    if($append) # Continue last word after quote
      { $argv[-1] .= $pre; }
    else # New word
      { push(@argv, $pre); }
    $append = $ch eq '\\';
    $argv[-1] .= substr($suf, 0, 1, "") # Append quoted character
	if $append;
  }
  errEx(1, "Invalid environment variable '$EnvOpts'", $SUsage)
      unless GetOptionsFromArray(\@argv, %OptS2OptVar);
  errEx(1, "Environment variable '$EnvOpts' may not contain arguments: '@argv'")
      if @argv;
}

exec("perldoc $FindBin::Bin/$FindBin::Script")
    if $help;

errEx(1, $SUsage)
    unless @ARGV == 2 && shift(@ARGV) eq $OptC;

errEx(1, "Unknown migration mode: '$migrate'")
    unless grep($migrate eq $_, @MigModes);

###############################################################################
###############################################################################
# More constants

###############################################################################
###############################################################################
# Variables

my $command = shift(@ARGV);

###############################################################################
###############################################################################
# Unspecialized functions

# Outputs the given strings `@lns' as error message. Returns 0.

sub errO(@) {
  my( @lns ) = @_;

  my $lns;
  foreach $lns ( @lns ) {
    my $ln;
    foreach $ln ( split(/\n/, $lns) )
      { print(STDERR "$FindBin::Script: $ln\n"); }
  }
  return 0;
}

##############################################################################

# Outputs the given strings `@lns' as verbose text. Returns 0.

sub vrbO(@) {
  my( @lns ) = @_;

  if($verb) {
    my $ln;
    foreach $ln ( @lns )
      { errO("## $ln"); }
  }
  return 0;
}

##############################################################################

# Outputs error messages `@msg' and exits with code `$code'.

sub errEx($@) {
  my( $code, @msgs ) = @_;

  errO(@msgs);
  exit($code);
}

###############################################################################
###############################################################################
# Specialized functions

=head1 EXAMPLE

A typical migration of I<Makefile>s from GNU B<make> <= V3.80 to GNU B<make> >=
V3.81 may work like this.

=over 4

=item 1. Set B<SHELL>

In the I<Makefile> written for GNU B<make> <= V3.80 define B<SHELL> like this

  SHELL = make3_80-sh --

If you have a setting for B<SHELL> already use this

  SHELL = make3_80-sh --shell 'OLD' --

replacing I<OLD> with the old setting.

With this setting the I<Makefile> should work with GNU B<make> >= V3.81 giving
you time for a migration.

=item 2. Locate migration needs

When you run the I<Makefile> set the environment variable
B<MAKE3_80_SH_OPTIONS> to C<--migrate warn>. With this you get an idea of where
you need to migrate commands.

=item 3. Migrate

Adapt the commands in your I<Makefile> to work with GNU B<make> >= V3.81. Add a
first line containing C<3.81> to all migrated commands.

=item 4. Control migration success

Set the environment variable B<MAKE3_80_SH_OPTIONS> to C<--migrate error> and
run your I<Makefile>. Repeat the migration until everything works as expected.

=item 5. Remove B<SHELL>

Remove the setting of B<SHELL> in your I<Makefile> or reset it to the old value
if you had a setting before.

Until this point I<Makefile> should run with both GNU B<make> <= V3.80 and GNU
B<make> >= V3.81.

=head1 ENVIRONMENT

=over 4

=item C<MAKE3_80_SH_OPTIONS>

Contains more command line options which are prepended before the B<-->.

Backslash quotes the next character. Whitespace is used for parsing the value
of the variable unless it is quoted.

=head1 BUGS

GNU B<make> <= V3.80 treated backslash-newline very special. In particular the
treatment differed according to the value of I<SHELL>. If I<SHELL> explicitly
or implicitly had a value of C</bin/sh> whitespace following the
backslash-newline has been preserved under some conditions. Under other
conditions such trailing whitespace has been replaced by a single blank. If
I<SHELL> had another value such trailing whitespace has always been replaced by
a single blank.

If you set I<SHELL> to B<make3_80-sh> then such trailing whitespace is always
replaced by a single blank - although this was not intended. Since effectively
this information is lost when B<make3_80-sh> gets control there is no way to
solve this problem.

However, if B<-s/--shell> is given with a value different from C</bin/sh> then
the V3.80 behavior is emulated.

=cut

###############################################################################

# Warn or error exit with `$msg'. `$migMode' gives the migration mode or an
# empty string for a warning independend of the migration mode.

sub warnO($$) {
  my( $msg, $migMode ) = @_;

  my $isErr = $migMode eq $MigError;
  my @s = ( sprintf("%s:%s %s", $isErr ? "Error" : "Warning",
		    $migMode ? " --migrate $migMode:" : "", $msg) );
  push(@s, sprintf("  Command: %s", $command));
  if($isErr)
    { errEx(2, @s); }
  else
    { errO(@s); }
}

###############################################################################

# Process backslash-newline combinations in `$cmd' and return result. If
# `$isBinSh' make executes `$cmd' by /bin/sh.

sub processBackslashNewline($$) {
  my( $cmd, $isBinSh ) = @_;

  unless($cmd =~ /\\\n/) {
    # No backslash-newline at all
    if($cmd =~ $FirstLineMarkerRE) {
      # Marker found without backslash-newline
      warnO("Found V3.81 marker but no backslash-newline - command may not work as expected",
	    "");
      warnO("Found V3.81 marker", $MigInfo)
	  if $migrate eq $MigInfo;
    }
    return $cmd;
  }

  if($` =~ $FirstLineMarkerRE) {
    # Special marker in first line
    warnO("Found V3.81 marker", $MigInfo)
	if $migrate eq $MigInfo;
    return $cmd;
  }

  warnO("Found unmarked backslash-newline", $migrate)
      if $migrate eq $MigWarn || $migrate eq $MigError;

  if(!$isBinSh) {
    # Not for standard shell - replace backslash-newline and leading white
    # space with a single blank
    $cmd =~ s/\\\n\s*/ /g;
    return $cmd;
  }

  my @parts = split(/'/, $cmd, -1); # Catch a trailing single quote
  for(my $i = 0; $i < @parts; $i++) {
    unless($i % 2) { # Current part is outside single quotes
      while($parts[$i] =~ /$MetaCharsRE/g) { # Contains a meta character
	next
	    # Odd number of preceding backslashes means meta character is
	    # quoted
	    if $` =~ /\\+$/ && length($&) % 2;

	# Unnquoted meta character found - replace backslash-newline and
	# leading white space with a single blank
	$cmd =~ s/\\\n\s*/ /g;
	return $cmd;
      }
      # Replace backslash-newlines outside single quotes and not surrounded by
      # any white space with a single blank
      $parts[$i] =~ s/(?<!\s)\\\n(?!\s)/ /g;
    }
  }
  $cmd = join("'", @parts);

  # Contains no unquoted meta characters
  # Replace remaining backslash-newline by nothing
  $cmd =~ s/\\\n//g;
  return $cmd;
}

##############################################################################
##############################################################################
# Now work

my @shellCmd = split(' ', $shell);
errEx(1, "Can not execute shell '$shellCmd[0]'")
    unless -x($shellCmd[0]);

vrbO("Processing $command");

$command = processBackslashNewline($command, $shell eq $DfltSh);

vrbO("Executing @shellCmd $OptC $command");

exec(@shellCmd, $OptC, $command);

=head1 SEE ALSO

L<make>

=head1 AUTHOR

Stefan Merten <stefan@merten-home.de>

=head1 LICENSE

This program is licensed under the terms of the GPL. See

	http://www.gnu.org/licenses/gpl.txt

=head1 AVAILABILTY

See

	http://www.merten-home.de/FreeSoftware/make3_80-sh/

=cut