#!/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