feature.pl: Tweak comment

[perl5.git] / regen / regen_lib.pl

diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index c56f564..dcee0a6 100644 (file)
--- a/regen/regen_lib.pl
+++ b/regen/regen_lib.pl
@@ -32,38 +32,11 @@ sub safer_unlink {
   return $cnt;
 }
 
-sub safer_rename_silent {
-  my ($from, $to) = @_;
-
-  # Some dosish systems can't rename over an existing file:
-  safer_unlink $to;
-  chmod 0600, $from if $Needs_Write;
-  rename $from, $to;
-}
-
-sub rename_if_different {
-  my ($from, $to) = @_;
-
-  if ($TAP) {
-      my $not = compare($from, $to) ? 'not ' : '';
-      print STDOUT $not . "ok - $0 $to\n";
-      safer_unlink($from);
-      return;
-  }
-  if (compare($from, $to) == 0) {
-      warn "no changes between '$from' & '$to'\n" if $Verbose > 0;
-      safer_unlink($from);
-      return;
-  }
-  warn "changed '$from' to '$to'\n" if $Verbose > 0;
-  push @Changed, $to unless $Verbose < 0;
-  safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
-}
-
 # Open a new file.
 sub open_new {
-    my ($final_name, $mode) = @_;
+    my ($final_name, $mode, $header) = @_;
     my $name = $final_name . '-new';
+    my $lang = $final_name =~ /\.(?:c|h|tab|act)$/ ? 'C' : 'Perl';
     my $fh = gensym;
     if (!defined $mode or $mode eq '>') {
        if (-f $name) {
@@ -77,14 +50,36 @@ sub open_new {
     }
     *{$fh}->{name} = $name;
     *{$fh}->{final_name} = $final_name;
-    *{$fh}->{lang} = ($final_name =~ /\.(?:c|h|tab|act)$/ ? 'C' : 'Perl');
+    *{$fh}->{lang} = $lang;
     binmode $fh;
+    print $fh read_only_top(lang => $lang, %$header) if $header;
     $fh;
 }
 
-sub safer_close {
+sub close_and_rename {
     my $fh = shift;
-    close $fh or die 'Error closing ' . *{$fh}->{name} . ": $!";
+    my $name = *{$fh}->{name};
+    close $fh or die "Error closing $name: $!";
+    my $final_name = *{$fh}->{final_name};
+
+    if ($TAP) {
+       my $not = compare($name, $final_name) ? 'not ' : '';
+       print STDOUT $not . "ok - $0 $final_name\n";
+       safer_unlink($name);
+       return;
+    }
+    if (compare($name, $final_name) == 0) {
+       warn "no changes between '$name' & '$final_name'\n" if $Verbose > 0;
+       safer_unlink($name);
+       return;
+    }
+    warn "changed '$name' to '$final_name'\n" if $Verbose > 0;
+    push @Changed, $final_name unless $Verbose < 0;
+
+    # Some dosish systems can't rename over an existing file:
+    safer_unlink $final_name;
+    chmod 0600, $name if $Needs_Write;
+    rename $name, $final_name or die "renaming $name to $final_name: $!";
 }
 
 sub read_only_top {
@@ -134,11 +129,16 @@ EOM
        ? wrap('# ', '# ', $raw) . "\n" : wrap('/* ', $style, $raw) . " */\n\n";
     $cooked =~ tr/\0/ /; # Don't break Larry's name etc
     $cooked =~ s/ +$//mg; # Remove all trailing spaces
+    $cooked =~ s! \*/\n!$args{quote}!s if $args{quote};
     return $cooked;
 }
 
-sub read_only_bottom {
-    my ($sources, $lang) = @_;
+sub read_only_bottom_close_and_rename {
+    my ($fh, $sources) = @_;
+    my $name = *{$fh}->{name};
+    my $lang = *{$fh}->{lang};
+    die "No final name specified at open time for $name"
+       unless *{$fh}->{final_name};
 
     my $comment;
     if ($sources) {
@@ -157,20 +157,9 @@ sub read_only_bottom {
        $comment =~ s! \* !/* !;
        $comment .= " */";
     }
-    return "$comment\n";
-}
-
-sub read_only_bottom_close_and_rename {
-    my ($fh, $sources) = @_;
-    my $name = *{$fh}->{name};
-    my $lang = *{$fh}->{lang};
-    die "No final name specified at open time for $name"
-       unless *{$fh}->{final_name};
-
-    print $fh "\n", read_only_bottom($sources, $lang);
+    print $fh "\n$comment\n";
 
-    safer_close($fh);
-    rename_if_different($name, *{$fh}->{final_name});
+    close_and_rename($fh);
 }
 
 sub tab {