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().

diff --git a/keywords.c b/keywords.c
index 077f7ce..7228d4b 100644 (file)
--- a/keywords.c
+++ b/keywords.c
@@ -3399,5 +3399,5 @@ unknown:
 }
 
 /* Generated from:
- * 1591f96938e2a916423e17015c46f40221214a9ba8670000a2bf43578af159c2 regen/keywords.pl
+ * 71ce7e36f80b1103f4a197ed423fe2dbd92fd9f619e126bfcf9f0b0153586bab regen/keywords.pl
  * ex: set ro: */

diff --git a/keywords.h b/keywords.h
index 5b412d6..1e2a036 100644 (file)
--- a/keywords.h
+++ b/keywords.h
@@ -268,5 +268,5 @@
 #define KEY_y                  252
 
 /* Generated from:
- * 1591f96938e2a916423e17015c46f40221214a9ba8670000a2bf43578af159c2 regen/keywords.pl
+ * 71ce7e36f80b1103f4a197ed423fe2dbd92fd9f619e126bfcf9f0b0153586bab regen/keywords.pl
  * ex: set ro: */

diff --git a/perly.act b/perly.act
index 8de864a..d8a5424 100644 (file)
--- a/perly.act
+++ b/perly.act
@@ -1711,5 +1711,5 @@ case 2:
 
 /* Generated from:
  * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y
- * 7fdc8be39a1ba22bcb9eb32a5e4e483f3b6abc1a1c95fea864ae5b7d46aa744b regen_perly.pl
+ * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl
  * ex: set ro: */

diff --git a/perly.h b/perly.h
index 08d488f..701fd5c 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -241,5 +241,5 @@ typedef union YYSTYPE
 
 /* Generated from:
  * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y
- * 7fdc8be39a1ba22bcb9eb32a5e4e483f3b6abc1a1c95fea864ae5b7d46aa744b regen_perly.pl
+ * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl
  * ex: set ro: */

diff --git a/perly.tab b/perly.tab
index 38fec29..3920cd2 100644 (file)
--- a/perly.tab
+++ b/perly.tab
@@ -1075,5 +1075,5 @@ static const toketypes yy_type_tab[] =
 
 /* Generated from:
  * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y
- * 7fdc8be39a1ba22bcb9eb32a5e4e483f3b6abc1a1c95fea864ae5b7d46aa744b regen_perly.pl
+ * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl
  * ex: set ro: */

diff --git a/regen/keywords.pl b/regen/keywords.pl
index 9d2f3ca..5f36956 100755 (executable)
--- 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 0d161f3..ecd5cd2 100644 (file)
--- 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 c52506a..ed3875e 100755 (executable)
--- 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 5ddce69..652b2b7 100644 (file)
--- 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 39e2452..dabbe34 100644 (file)
--- 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 abfb8cb..6ed84f3 100644 (file)
--- 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 e18a3ba..4715236 100644 (file)
--- 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 e6cd8be..3d65d87 100644 (file)
--- 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))

diff --git a/regen_perly.pl b/regen_perly.pl
index 668f164..a96a918 100644 (file)
--- a/regen_perly.pl
+++ b/regen_perly.pl
@@ -97,13 +97,13 @@ my ($actlines, $tablines) = extract($clines);
 
 $tablines .= make_type_tab($y_file, $tablines);
 
-my $read_only = read_only_top(lang => 'C', by => $0, from => $y_file);
+my ($act_fh, $tab_fh, $h_fh) = map {
+    open_new($_, '>', { by => $0, from => $y_file });
+} $act_file, $tab_file, $h_file;
 
-my $act_fh = open_new($act_file);
-print $act_fh $read_only, $actlines;
+print $act_fh $actlines;
 
-my $tab_fh = open_new($tab_file);
-print $tab_fh $read_only, $tablines;
+print $tab_fh $tablines;
 
 unlink $tmpc_file;
 
@@ -112,9 +112,6 @@ unlink $tmpc_file;
 # C<#line 188 "perlytmp.h"> gets picked up by make depend, so remove them.
 
 open my $tmph_fh, '<', $tmph_file or die "Can't open $tmph_file: $!\n";
-my $h_fh = open_new($h_file);
-
-print $h_fh $read_only;
 
 my $endcore_done = 0;
 # Token macros need to be generated manually on bison 2.4