1#!/usr/local/bin/perl
2;#
3use strict;
4use vars qw($opt_l $opt_v %save);
5use Getopt::Std;
6
7;#
8BEGIN {
9	%save = ();
10}
11
12;#
13END {
14	my $file;
15	my $save;
16	while (($file, $save) = each %save) {
17		if (rename($save, $file)) {
18			warn("restore $save -> $file: o.k.\n") if $opt_v;
19		} else {
20			warn("rename($save, $file): $!\n");
21		}
22	}
23}
24
25;# prototypes
26sub pm_find ($;$);
27sub pm_copy ($$);
28sub pm_comp ($$);
29sub pm_conv ($;$);
30
31;# parse options
32getopts("lv") || die("Usage: $0 [-l] [-v] [file...]\n");
33
34;# default files.
35@ARGV = &pm_find('.', $opt_l) unless @ARGV;
36
37;# do real work.
38for my $i (@ARGV) {
39	my $save = $i.'.save';
40	unlink($save) if -e $save;
41	$save{$i} = $save;
42	rename($i, $save) or die("rename($i, $save): $!\n");
43	warn("save $i -> $save: o.k.\n") if $opt_v;
44	&pm_copy($save, $i) or die("pm_copy($save, $i): $!\n");
45	warn("copy $save -> $i: o.k.\n") if $opt_v;
46	&pm_conv($i, 0) or die("pm_conv($i, 0): failed\n");
47	warn("convert $i: o.k.\n") if $opt_v;
48}
49
50;# try check...
51for my $i (@ARGV) {
52	system '/usr/local/bin/perl', '-cw', $i;
53}
54
55# success return.
56exit;
57
58;#
59sub pm_find ($;$) {
60	my $dir = shift;
61	my $norecurse = shift;
62	my @array = ();
63
64	local *DIR;
65	opendir(DIR, $dir) or die("find: opendir($dir): $!\n");
66	for my $e (sort readdir(DIR)) {
67		next if $e eq '.' || $e eq '..';
68		my $p = "$dir/$e";
69		next if $norecurse && -d $p;
70		next if $e eq 'blib' && -d $p;
71		push(@array, $p), next if -f $p && $p =~ /\.pm$/;
72		push(@array, &pm_find($p)), next if -d $p;
73	}
74	closedir(DIR);
75	@array;
76}
77
78;#
79sub pm_copy ($$) {
80	my $from = shift;
81	my $to = shift;
82
83	-f $from or die("pm_copy: $from is not a plan file.\n");
84
85	local *FROM;
86	open(FROM, $from) or die("copy: open($from): $!\n");
87	local *TO;
88	open(TO, '>'.$to) or die("copy: open(>$to): $!\n");
89
90	local $_;
91	print TO while <FROM>;
92
93	close(TO);
94	close(FROM);
95
96	# success
97	1;
98}
99
100;#
101sub pm_comp ($$) {
102	my $old = shift;
103	my $new = shift;
104
105	local *OLD;
106	open(OLD, $old) or die("comp: open($old): $!\n");
107	local *NEW;
108	open(NEW, $new) or die("comp: open($new): $!\n");
109
110	my $a = undef;
111	my $b = undef;
112	while (defined($a = <OLD>) && defined($b = <NEW>)) {
113		my $comp = $a cmp $b;
114		return $comp if $comp;
115	}
116
117	close(OLD);
118	close(NEW);
119
120	defined($a) ? 1 : defined($b) ? -1 : 0;
121}
122
123;#
124sub pm_conv ($;$) {
125	my $file = shift;
126	my $split = @_ ? shift : 0;
127	my $delim = $split ? '/;# A special marker for AutoSplit/' : '$';
128
129	local *PIPE;
130	my $pid = open(PIPE, "|-");
131
132	defined($pid) or die("pm_conv: can't fork: $!\n");
133
134	if ($pid == 0) { # in kid's process...
135		open(STDOUT, ">/dev/null");
136		open(STDERR, ">/dev/null");
137		exec 'ed', '-', '-s', $file;
138		die("pm_conv: exec(ed): $!\n");
139	}
140
141	# or in parent's process
142	print PIPE "g/^__END__\$/d\n";
143	print PIPE "g/^1;\$/d\n";
144	print PIPE "$delim\n";
145	print PIPE "a\n";
146	print PIPE "1;\n";
147	print PIPE "__END__\n";
148	print PIPE ".\n";
149	print PIPE "w\n";
150	print PIPE "q\n";
151	close(PIPE);
152
153	# check result of editor.
154	die("conv: ed returns $?") if $?;
155
156	# success
157	1;
158}
159