#!/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 ; 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 = ) && defined($b = )) { 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; }