Rewrite bignum’s hex and oct overrides
[perl.git] / win32 / config_h.PL
1 #!perl -w
2 use strict;
3
4 BEGIN { warn "Running ".__FILE__."\n" };
5 BEGIN 
6  {
7   require "Config.pm";
8   die "Config.pm:$@" if $@;
9   Config->import;
10  }
11 use File::Compare qw(compare);
12 use File::Copy qw(copy);
13 use File::Basename qw(fileparse);
14
15 my ($name, $dir) = fileparse($0);
16 $name =~ s#^(.*)\.PL$#../$1.SH#;
17 my %opt;
18 while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
19  {
20   $opt{$1}=$2;
21   shift(@ARGV);
22  }
23
24 $opt{CONFIG_H} ||= 'config.h';
25 $opt{CORE_DIR} ||= '../lib/CORE';
26
27 warn "Writing $opt{CONFIG_H}\n";
28
29 open(SH,"<$name") || die "Cannot open $name:$!";
30 while (<SH>)
31  {
32   last if /^\s*sed/;
33  }
34 my($term,$file,$pat) = /^\s*sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;
35
36 $file =~ s/^\$(\w+)$/$opt{$1}/g;
37
38 my $str = "sub munge\n{\n";
39
40 while ($pat =~ s/-e\s+'([^']*)'\s*//)
41  {
42   my $e = $1;
43   $e =~ s/\\([\(\)])/$1/g;
44   $e =~ s/\\(\d)/\$$1/g; 
45   $str .= "$e;\n";
46  }
47 $str .= "}\n";
48
49 eval $str;
50
51 die "$str:$@" if $@;
52
53 open(H,">$file.new") || die "Cannot open $file.new:$!";
54 while (<SH>)
55  {
56   last if /^$term$/o;
57   s/\$([\w_]+)/Config($1)/eg;
58   s/`([^\`]*)`/BackTick($1)/eg;
59   munge();
60   s/\\\$/\$/g;
61   s#/[ *\*]*\*/#/**/#;
62   s#(.)/\*\*/#$1/ **/# if(/^\/\*/); #avoid "/*" inside comments
63   if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
64    {
65      $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "(PERL_VERSION_STRING, NULL))\t/**/\n";
66    }
67   # incpush() handles archlibs, so disable them
68   elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
69    {
70      $_ = "/*#define ". $1 . "_EXP \"\"\t/ **/\n";
71    }
72   elsif (/^\s*#define\s+CPP(STDIN|RUN)\s+"gcc(.*)"\s*$/)
73    {
74      $_ = "#define CPP" . $1 . " \"" . $opt{ARCHPREFIX} . "gcc" . $2 . "\"\n";
75    }
76   print H;
77  }
78 close(H);
79 close(SH);
80
81
82 chmod(0666,"$opt{CORE_DIR}/$opt{CONFIG_H}");
83 copy("$file.new","$opt{CORE_DIR}/$opt{CONFIG_H}") || die "Cannot copy:$!";
84 chmod(0444,"$opt{CORE_DIR}/$opt{CONFIG_H}");
85
86 if (compare("$file.new",$file))
87  {
88   warn "$file has changed\n";
89   chmod(0666,$file);
90   unlink($file);
91   rename("$file.new",$file);
92   exit(1);
93  }
94 else
95  {
96   unlink ("$file.new");
97   exit(0);
98  }
99
100 sub Config
101 {
102  my $var = shift;
103  my $val = $Config{$var};
104  $val = 'undef' unless defined $val;
105  $val =~ s/\\/\\\\/g;
106  return $val;
107 }
108
109 sub BackTick
110 {
111  my $cmd = shift;
112  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
113   {
114    my($data,$pat) = ($1,$2);
115    $data =~ s/\s+/ /g;
116    eval "\$data =~ $pat";
117    return $data;
118   }
119  else
120   {
121    die "Cannot handle \`$cmd\`";
122   }
123  return $cmd;
124 }