#!/usr/local/bin/perl
;#
use strict;
use vars qw($opt_l $opt_v %save);
use Getopt::Std;

;#
BEGIN {
	%save = ();
}

;#
END {
	my $file;
	my $save;
	while (($file, $save) = each %save) {
		if (rename($save, $file)) {
			warn("restore $save -> $file: o.k.\n") if $opt_v;
		} else {
			warn("rename($save, $file): $!\n");
		}
	}
}

;# prototypes
sub pm_find ($;$);
sub pm_copy ($$);
sub pm_comp ($$);
sub pm_conv ($;$);

;# parse options
getopts("lv") || die("Usage: $0 [-l] [-v] [file...]\n");

;# default files.
@ARGV = &pm_find('.', $opt_l) unless @ARGV;

;# do real work.
for my $i (@ARGV) {
	my $save = $i.'.save';
	unlink($save) if -e $save;
	$save{$i} = $save;
	rename($i, $save) or die("rename($i, $save): $!\n");
	warn("save $i -> $save: o.k.\n") if $opt_v;
	&pm_copy($save, $i) or die("pm_copy($save, $i): $!\n");
	warn("copy $save -> $i: o.k.\n") if $opt_v;
	&pm_conv($i, 0) or die("pm_conv($i, 0): failed\n");
	warn("convert $i: o.k.\n") if $opt_v;
}

;# try check...
for my $i (@ARGV) {
	system '/usr/local/bin/perl', '-cw', $i;
}

# success return.
exit;

;#
sub pm_find ($;$) {
	my $dir = shift;
	my $norecurse = shift;
	my @array = ();

	local *DIR;
	opendir(DIR, $dir) or die("find: opendir($dir): $!\n");
	for my $e (sort readdir(DIR)) {
		next if $e eq '.' || $e eq '..';
		my $p = "$dir/$e";
		next if $norecurse && -d $p;
		next if $e eq 'blib' && -d $p;
		push(@array, $p), next if -f $p && $p =~ /\.pm$/;
		push(@array, &pm_find($p)), next if -d $p;
	}
	closedir(DIR);
	@array;
}

;#
sub pm_copy ($$) {
	my $from = shift;
	my $to = shift;

	-f $from or die("pm_copy: $from is not a plan file.\n");

	local *FROM;
	open(FROM, $from) or die("copy: open($from): $!\n");
	local *TO;
	open(TO, '>'.$to) or die("copy: open(>$to): $!\n");

	local $_;
	print TO while <FROM>;

	close(TO);
	close(FROM);

	# success
	1;
}

;#
sub pm_comp ($$) {
	my $old = shift;
	my $new = shift;

	local *OLD;
	open(OLD, $old) or die("comp: open($old): $!\n");
	local *NEW;
	open(NEW, $new) or die("comp: open($new): $!\n");

	my $a = undef;
	my $b = undef;
	while (defined($a = <OLD>) && defined($b = <NEW>)) {
		my $comp = $a cmp $b;
		return $comp if $comp;
	}

	close(OLD);
	close(NEW);

	defined($a) ? 1 : defined($b) ? -1 : 0;
}

;#
sub pm_conv ($;$) {
	my $file = shift;
	my $split = @_ ? shift : 0;
	my $delim = $split ? '/;# A special marker for AutoSplit/' : '$';

	local *PIPE;
	my $pid = open(PIPE, "|-");

	defined($pid) or die("pm_conv: can't fork: $!\n");

	if ($pid == 0) { # in kid's process...
		open(STDOUT, ">/dev/null");
		open(STDERR, ">/dev/null");
		exec 'ed', '-', '-s', $file;
		die("pm_conv: exec(ed): $!\n");
	}

	# or in parent's process
	print PIPE "g/^__END__\$/d\n";
	print PIPE "g/^1;\$/d\n";
	print PIPE "$delim\n";
	print PIPE "a\n";
	print PIPE "1;\n";
	print PIPE "__END__\n";
	print PIPE ".\n";
	print PIPE "w\n";
	print PIPE "q\n";
	close(PIPE);

	# check result of editor.
	die("conv: ed returns $?") if $?;

	# success
	1;
}


syntax highlighted by Code2HTML, v. 0.9.1