X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/af00134636ffe4172cbffeaed3bbad802e58d8a0..bb5cff7d658d1934f2c79f668c3b916bd9abbcbb:/regen/regen_lib.pl?ds=sidebyside

diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index 9008629..b4d9f86 100644
--- a/regen/regen_lib.pl
+++ b/regen/regen_lib.pl
@@ -3,6 +3,7 @@ use strict;
 use vars qw($Needs_Write $Verbose @Changed $TAP);
 use File::Compare;
 use Symbol;
+use Text::Wrap;
 
 # Common functions needed by the regen scripts
 
@@ -64,14 +65,64 @@ sub safer_open {
     my $name = shift;
     my $fh = gensym;
     open $fh, ">$name" or die "Can't create $name: $!";
-    *{$fh}->{SCALAR} = $name;
+    *{$fh}->{name} = $name;
     binmode $fh;
     $fh;
 }
 
 sub safer_close {
     my $fh = shift;
-    close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!";
+    close $fh or die 'Error closing ' . *{$fh}->{name} . ": $!";
+}
+
+sub read_only_top {
+    my %args = @_;
+    die "Missing language argument" unless defined $args{lang};
+    die "Unknown language argument '$args{lang}'"
+	unless $args{lang} eq 'Perl' or $args{lang} eq 'C';
+    my $style = $args{style} ? " $args{style} " : '   ';
+
+    my $raw = "-*- buffer-read-only: t -*-\n";
+
+    if ($args{file}) {
+	$raw .= "\n   $args{file}\n";
+    }
+    if ($args{copyright}) {
+	local $" = ', ';
+	local $Text::Wrap::columns = 75;
+	$raw .= wrap('   ', '   ', <<"EOM") . "\n";
+
+Copyright (C) @{$args{copyright}} by\0Larry\0Wall\0and\0others
+
+You may distribute under the terms of either the GNU General Public
+License or the Artistic License, as specified in the README file.
+EOM
+    }
+
+    $raw .= "!!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!\n";
+
+    if ($args{by}) {
+	$raw .= "This file is built by $args{by}";
+	if ($args{from}) {
+	    my @from = ref $args{from} eq 'ARRAY' ? @{$args{from}} : $args{from};
+	    my $last = pop @from;
+	    if (@from) {
+		$raw .= ' from ' . join (', ', @from) . " and $last";
+	    } else {
+		$raw .= " from $last";
+	    }
+	}
+	$raw .= ".\n";
+    }
+    $raw .= "Any changes made here will be lost!\n";
+    $raw .= $args{final} if $args{final};
+
+    local $Text::Wrap::columns = 78;
+    my $cooked = $args{lang} eq 'Perl'
+	? 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
+    return $cooked;
 }
 
 1;