Add an optional third argument to open_new(), to invoke read_only_top() with.

Merge together many calls to open_new() and read_only_top().

8 files changed, 44 insertions, 52 deletions

diff --git a/regen/keywords.pl b/regen/keywords.pl
index 9d2f3ca83d..5f3695602c 100755
--- a/regen/keywords.pl
+++ b/regen/keywords.pl
@@ -13,14 +13,12 @@ use Devel::Tokenizer::C 0.05;
 
 require 'regen/regen_lib.pl';
 
-my $h = open_new('keywords.h');
-my $c = open_new('keywords.c');
-
-print $h read_only_top(lang => 'C', by => 'regen/keywords.pl',
-		       from => 'its data', file => 'keywords.h', style => '*',
-		       copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]);
-print $c read_only_top(lang => 'C', by => 'regen/keywords.pl',
-		       from => 'its data', style => '*');
+my $h = open_new('keywords.h', '>',
+		 { by => 'regen/keywords.pl', from => 'its data',
+		   file => 'keywords.h', style => '*',
+		   copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]});
+my $c = open_new('keywords.c', '>',
+		 { by => 'regen/keywords.pl', from => 'its data', style => '*'});
 
 my %by_strength;
 
diff --git a/regen/mk_PL_charclass.pl b/regen/mk_PL_charclass.pl
index 0d161f3b10..ecd5cd2ec9 100644
--- a/regen/mk_PL_charclass.pl
+++ b/regen/mk_PL_charclass.pl
@@ -222,8 +222,8 @@ my @C1 = qw(
                 APC
             );
 
-my $out_fh = open_new('l1_char_class_tab.h');
-print $out_fh read_only_top(lang => 'C', style => '*', by => $0, from => $file);
+my $out_fh = open_new('l1_char_class_tab.h', '>',
+		      {style => '*', by => $0, from => $file});
 
 # Output the table using fairly short names for each char.
 for my $ord (0..255) {
diff --git a/regen/opcode.pl b/regen/opcode.pl
index c52506a2a3..ed3875e678 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -20,8 +20,14 @@ BEGIN {
     require 'regen/regen_lib.pl';
 }
 
-my $oc = open_new('opcode.h');
-my $on = open_new('opnames.h');
+my $oc = open_new('opcode.h', '>',
+		  {by => 'regen/opcode.pl', from => 'its data',
+		   file => 'opcode.h', style => '*',
+		   copyright => [1993 .. 2007]});
+
+my $on = open_new('opnames.h', '>',
+		  { by => 'regen/opcode.pl', from => 'its data', style => '*',
+		    file => 'opnames.h', copyright => [1999 .. 2008] });
 
 # Read data.
 
@@ -138,10 +144,7 @@ foreach my $sock_func (qw(socket bind listen accept shutdown
 
 # Emit defines.
 
-print $oc read_only_top(lang => 'C', by => 'regen/opcode.pl', from => 'its data',
-			file => 'opcode.h', style => '*',
-			copyright => [1993 .. 2007]),
-    "#ifndef PERL_GLOBAL_STRUCT_INIT\n\n";
+print $oc    "#ifndef PERL_GLOBAL_STRUCT_INIT\n\n";
 
 {
     my $last_cond = '';
@@ -178,10 +181,7 @@ print $oc read_only_top(lang => 'C', by => 'regen/opcode.pl', from => 'its data'
     unimplemented();
 }
 
-print $on read_only_top(lang => 'C', by => 'regen/opcode.pl',
-			from => 'its data', style => '*',
-			file => 'opnames.h', copyright => [1999 .. 2008]),
-    "typedef enum opcode {\n";
+print $on "typedef enum opcode {\n";
 
 my $i = 0;
 for (@ops) {
@@ -441,9 +441,8 @@ sub gen_op_is_macro {
     }
 }
 
-my $pp = open_new('pp_proto.h');
-
-print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data');
+my $pp = open_new('pp_proto.h', '>',
+		  { by => 'opcode.pl', from => 'its data' });
 
 {
     my %funcs;
diff --git a/regen/overload.pl b/regen/overload.pl
index 5ddce69e12..652b2b7b86 100644
--- a/regen/overload.pl
+++ b/regen/overload.pl
@@ -30,13 +30,16 @@ while (<DATA>) {
   push @names, $name;
 }
 
-my $c = open_new('overload.c');
-my $h = open_new('overload.h');
-mkdir("lib/overload", 0777) unless -d 'lib/overload';
-my $p = open_new('lib/overload/numbers.pm');
+my ($c, $h) = map {
+    open_new($_, '>',
+	     { by => 'regen/overload.pl', file => $_, style => '*',
+	       copyright => [1997, 1998, 2000, 2001, 2005 .. 2007, 2011] });
+} 'overload.c', 'overload.h';
 
-print $p read_only_top(lang => 'Perl', by => 'regen/overload.pl',
-		       file => 'lib/overload/numbers.pm', copyright => [2008]);
+mkdir("lib/overload", 0777) unless -d 'lib/overload';
+my $p = open_new('lib/overload/numbers.pm', '>',
+		 { by => 'regen/overload.pl',
+		   file => 'lib/overload/numbers.pm', copyright => [2008] });
 
 {
 local $" = "\n    ";
@@ -57,14 +60,6 @@ our \@enums = qw#
 EOF
 }
 
-for ([$c, 'overload.c'], [$h, 'overload.h']) {
-    my ($handle, $file) = @$_;
-    print $handle read_only_top(lang => 'C', by => 'regen/overload.pl',
-				file => $file, style => '*',
-				copyright => [1997, 1998, 2000, 2001,
-					     2005 .. 2007, 2011]);
-}
-
 print $h "enum {\n";
 
 for (0..$#enums) {
diff --git a/regen/reentr.pl b/regen/reentr.pl
index 39e24525c2..dabbe346c3 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -51,11 +51,11 @@ my %map = (
 # Example #3: S_CBI   means type func_r(const char*, char*, int)
 
 
-my $h = open_new('reentr.h');
-print $h read_only_top(lang => 'C', by => 'regen/reentr.pl',
-		       from => 'data in regen/reentr.pl',
-		       file => 'reentr.h', style => '*',
-		       copyright => [2002, 2003, 2005 .. 2007]);
+my $h = open_new('reentr.h', '>',
+		 { by => 'regen/reentr.pl',
+		   from => 'data in regen/reentr.pl',
+		   file => 'reentr.h', style => '*',
+		   copyright => [2002, 2003, 2005 .. 2007]});
 
 print $h <<EOF;
 #ifndef REENTR_H
diff --git a/regen/regcomp.pl b/regen/regcomp.pl
index abfb8cbb45..6ed84f3293 100644
--- a/regen/regcomp.pl
+++ b/regen/regcomp.pl
@@ -125,10 +125,8 @@ EXTCONST U8 PL_${varname}_bitmask[] = {
 EOP
 }
 
-my $out = open_new('regnodes.h');
-
-print $out read_only_top(lang => 'C', by => 'regen/regcomp.pl',
-			 from => 'regcomp.sym');
+my $out = open_new('regnodes.h', '>',
+		   { by => 'regen/regcomp.pl', from => 'regcomp.sym' });
 printf $out <<EOP,
 /* Regops and State definitions */
 
diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index e18a3ba9b8..4715236050 100644
--- a/regen/regen_lib.pl
+++ b/regen/regen_lib.pl
@@ -34,8 +34,9 @@ sub safer_unlink {
 
 # 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) {
@@ -49,8 +50,9 @@ 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;
 }
 
diff --git a/regen/warnings.pl b/regen/warnings.pl
index e6cd8bea84..3d65d87a55 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -260,11 +260,11 @@ if (@ARGV && $ARGV[0] eq "tree")
     exit ;
 }
 
-my $warn = open_new('warnings.h');
-my $pm = open_new('lib/warnings.pm');
+my ($warn, $pm) = map {
+    open_new($_, '>', { by => 'regen/warnings.pl' });
+} 'warnings.h', 'lib/warnings.pm';
 
-print $pm read_only_top(lang => 'Perl', by => 'regen/warnings.pl');
-print $warn read_only_top(lang => 'C', by => 'regen/warnings.pl'), <<'EOM';
+print $warn <<'EOM';
 
 #define Off(x)			((x) / 8)
 #define Bit(x)			(1 << ((x) % 8))