use ExtUtils::MakeMaker;
use strict;
use File::Copy;
use File::Find;

my ($perlmacs_ver, $emacs_ver, $emacs_src, $emacs_tar_gz, @configure_opts);
my $aborted = "\n### $0 aborted\n";
my $gzip_size_at_least = 14_000_000;
my ($pure_emacs_src);  # unpatched tree for making diffs

$| = 1;  # for when we ask questions

check_perl_ver (5.005);
find_perlmacs_ver ();  # finds perlmacs and emacs version #s in version.el

for my $i (0 .. $#ARGV) {

  if ($ARGV[$i] =~ /^-*h/) {
    die "\nUsage: perl Makefile.PL [EMACS_SRC=dir/emacs-$emacs_ver\[.tar.gz]] [MakeMaker-opts] [-- configure-opts]\n";
  }

  if ($ARGV[$i] =~ /^EMACS_SRC=(.+)/) {
    ($1 =~ /\.tar\.gz$/ ? $emacs_tar_gz : $emacs_src) = $1;
    splice @ARGV, $i, 1;
  }

  if ($ARGV[$i] =~ /^PURE_EMACS_SRC=(.+)/) {
    $pure_emacs_src = $1;
    splice @ARGV, $i, 1;
  }

  next unless $ARGV[$i] eq '--';
  @configure_opts = splice @ARGV, $i;
  shift @configure_opts;

  for (@configure_opts) {
    s|\$|\$\$|g;
    if (s|'|'\\''|g) { $_ = "'$_'" }
  }
  last;
}

grep { /^--p/ } @configure_opts
  or push @configure_opts, '--prefix=$(PREFIX)';

find_emacs_src () unless defined $emacs_src;
unpack_emacs_src () if defined $emacs_tar_gz;
prep_emacs_src ();

WriteMakefile (
	       VERSION => $perlmacs_ver,
	       NAME => 'Emacs::PerlmacsPatch',
	       dist => { DIST_DEFAULT => 'emacs-perlmacs.diff tardist' },
	       );

# Makefile must depend on version.el, but MakeMaker makes no provision
# for this, as far as I can tell.
# So bludgeon it into shape.
rename ("Makefile", "Makefile.tmp") or exit;
open MFT, "Makefile.tmp" or die $!;
open MF, ">Makefile" or die $!;
while (<MFT>) {
  s|^CONFIGDEP =|CONFIGDEP = perlmacs/lisp/version.el|;
  print MF or die $!;
}
unlink "Makefile.tmp";
exit;


sub MY::post_initialize {
  return "PURE_EMACS_SRC = "
    .($pure_emacs_src || "/src/emacs-$emacs_ver")."\n";
}

sub MY::top_targets {
  return <<END;

all : $emacs_src/build $emacs_src/build/Makefile
	cd $emacs_src/build && \$(MAKE) all

$emacs_src/build/Makefile : Makefile
	cd $emacs_src/build && PERL=\$(FULLPERL) ../configure @configure_opts

$emacs_src/build :
	mkdir \$\@
END
}

sub MY::test {
    # Something's wrong with the exit stati returned to Test::Harness.
    return <<END;

test : all
	cd $emacs_src/build/perl && HARNESS_IGNORE_EXITCODE=1 make test

testdb : all
	cd $emacs_src/build/perl && HARNESS_IGNORE_EXITCODE=1 make testdb
END
}

sub MY::install {
  return <<END;

install : all
	cd $emacs_src/build && \$(MAKE) install
END
}

sub MY::postamble {
  return <<END;

emacs-perlmacs.diff : $emacs_src $emacs_src/src $emacs_src/lisp \$(PURE_EMACS_SRC)
	test -d perlmacs-$perlmacs_ver || ln -s $emacs_src perlmacs-$perlmacs_ver
	test ! -f emacs-$emacs_ver/src/perlmacs.c
	test -d emacs-$emacs_ver || ln -s \$(PURE_EMACS_SRC) emacs-$emacs_ver
	diff -cr --exclude=build --exclude=\\*.elc --exclude=version.el \\
		--exclude=CVS --exclude=README\\* --exclude=BUGS \\
		emacs-$emacs_ver perlmacs-$perlmacs_ver \\
		> \$\@.tmp || test \$\$? = 1
	mv -f \$\@.tmp \$\@

clean ::
	-cd $emacs_src/build && \$(MAKE) clean
	\$(RM_F) perlmacs-* emacs-perlmacs.diff.tmp

distclean ::
	\$(RM_RF) $emacs_src/build
END
}

sub check_perl_ver {
    my ($wanted) = @_;
    return if $] >= $wanted;
    die <<DEAD;

Your Perl (version $]) is too old for this Perlmacs patch.
Please use Perl $wanted or higher.

### $0 aborted.
DEAD
}

sub analyze_version_file {
    my $verfile = shift;
    my ($p, $e);
    local (*VER);
    open VER, $verfile or die "\nCan't open $verfile: $!\n$aborted";
    map {
	$p = $1 if /defconst perlmacs-version "(.*?)"/;
	$e = $1 if /defconst emacs-version "(.*?)"/;
    } <VER>;
    return ($p, $e);
}

sub find_perlmacs_ver {
    my $verfile = "perlmacs/lisp/version.el";
    print "Finding Perlmacs version...";
    ($perlmacs_ver, $emacs_ver) = analyze_version_file ($verfile);
    defined ($perlmacs_ver) or
	die "\nCan't deduce Perlmacs version from contents of $verfile.\n$aborted";
    defined ($emacs_ver) or
	die "\nCan't deduce required Emacs version from contents of $verfile.\n$aborted";
    print "$perlmacs_ver\n";
}

sub find_emacs_src {
    my $gzipname = "emacs-$emacs_ver.tar.gz";
    my $dirname = "emacs-$emacs_ver";
    my $maybe_dir = "";
    my $def_url = "ftp://metalab.unc.edu/pub/gnu/emacs/$gzipname";
    my ($ans, $ua, $url, $request, $response);

    if (-f "perlmacs/ChangeLog") {
      $emacs_src = "perlmacs";
      return;
    }

    $emacs_src = $dirname;
    return if defined $emacs_tar_gz || -e $emacs_src;

    # prefer gzipped since it avoids asking the user whether to patch
    # the found tree.
    foreach (qw(. .. ../.. ../../..)) {
	next unless -f "$_/$gzipname"
	    && -s "$_/$gzipname" >= $gzip_size_at_least;
	($emacs_tar_gz = "$_/$gzipname") =~ s:^\./::;
	return;
    }
    foreach (qw(.. ../.. ../../..)) {
	next unless -d "$_/$dirname";
	$maybe_dir = "$_/$dirname";
	last;
    }
    print "\nWhere should I find the Emacs $emacs_ver source tree to patch?\n";
    print "Specify a tar.gz file, a directory, `net' to download now,\n";
    print "or `q' to give up.\n\n";

    while (1) {
	print "Emacs source location? [$maybe_dir] ";
	$ans = <STDIN>;
	chomp $ans;

	if ($ans eq '') {
	    next if $maybe_dir eq '';
	    $emacs_src = $maybe_dir;
	    return;
	}
	die $aborted if ("quit" =~ /^$ans/);
	if ($ans =~ /\.gz$/) {
	    if (-f $ans) {
		$emacs_tar_gz = $ans;
		return;
	    }
	    print "That is not a file.  Did you mistype the name?\n";
	    next;
	}
	last if $ans eq 'net';
	if (-d $ans) {
	    $emacs_src = $ans;
	    return;
	}
	print "\nPlease enter a filename ending in .gz or a directory name.\n";
    }

    # here they have asked for a download.
    print "\nNOTE: $gzipname is over "
	.int($gzip_size_at_least/1_000_000)." megabytes.\n";
    print "Do you really want me to try to download it? [y] ";
    die $aborted unless <STDIN> =~ /^($|[yY])/;

    require LWP::UserAgent;
    require URI;
    require URI::Heuristic;

    $ua = new LWP::UserAgent;
    $request = HTTP::Request->new ('GET');

    while (1) {
	print "Download $gzipname from where? [$def_url] ";
	$ans = <STDIN>;
	chomp $ans;

	$ans = $def_url if $ans eq '';
	die $aborted if ("quit" =~ /^$ans/);

	if (! $ans =~ /$gzipname$/) {
	    $ans =~ s:/$::;
	    $ans .= "/$gzipname";
	}

	# snarfed from lwp-request
	if ($ans =~ /^\w+:/) {  # is there any scheme specification
	    $url = URI->new($ans);
	} else {
	    $url = URI::Heuristic::uf_uri($ans);
        }
	$request->url($url);
	print "Attempting to fetch $ans\n(this will take a while)...";
	$response = $ua->request($request, $gzipname);
	if ($response->is_success && -s $gzipname >= $gzip_size_at_least) {
	    print "success!!\n";
	    $emacs_tar_gz = $gzipname;
	    return;
	}
	$def_url = 'q' if $ans eq $def_url;
	print "failed.\nType `q' if you want to give up.\n";
    }
}

sub unpack_emacs_src {
    print "Unpacking $emacs_tar_gz...";
    system ("gzip -dc $emacs_tar_gz |tar xf -")
	and die $aborted;
    print "done\n";
}

sub prep_emacs_src {
    -d $emacs_src or die "\n$emacs_src is not a directory.\n$aborted";
    print "Using source in $emacs_src.\n";
    my $verfile = "$emacs_src/lisp/version.el";
    my ($p, $e) = analyze_version_file ($verfile);
    defined ($e)
	or die "\nCan't find Emacs version number in $verfile.\n$aborted";
    $e eq $emacs_ver or die <<DEAD;

Emacs source version mismatch.
$emacs_src contains version $e.
This patch requires Emacs $emacs_ver.

### $0 aborted.
DEAD
    if (defined $p) {
	return if $p eq $perlmacs_ver;
	die <<DEAD;

$emacs_src contains Perlmacs version $p.
This patch for Perlmacs $perlmacs_ver must be applied to a fresh
Emacs $emacs_ver tree.

### $0 aborted.
DEAD
    }
    print "Patching $emacs_src...\n";
    my $cmd = "patch -p0";
    $cmd = "( cd $emacs_src; patch -p1 )" if $emacs_src ne "emacs-$emacs_ver";
    open PATCH, "|$cmd" or die "\nCan't run `$cmd'.\n$aborted";
    open DIFF, "emacs-perlmacs.diff"
	or die "\nCan't open emacs-perlmacs.diff: $!\n$aborted";
    print PATCH while read DIFF, $_, 4096;
    close PATCH;
    $? and die "\n`$cmd' returned status $?\n$aborted";

    for my $dir ('perl', 'perl/lib', 'perl/lib/Emacs', 'perl/t', 'src/xs') {
	print "mkdir $emacs_src/$dir\n";
	mkdir "$emacs_src/$dir", 0777;
    }

    my @files;
    find sub { push @files, $File::Find::name if -f }, "perlmacs";
    for (@files) {
	s|^perlmacs/||;
	if (-e "$emacs_src/$_" && ! -w "$emacs_src/$_") {
	    print "Removing $emacs_src/$_\n";
	    unlink "$emacs_src/$_"
		or die "Can't remove $emacs_src/$_: $!\n$aborted";
	}
	print "Copying perlmacs/$_ to $emacs_src/$_\n";
	copy "perlmacs/$_", "$emacs_src/$_"
	    or die "Can't copy file: $!\n$aborted";
    }
}