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