This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PATCH: perl@11564] introducing perlivp
[perl5.git] / win32 / config_h.PL
1 #
2 use Config;
3 use File::Compare qw(compare);
4 use File::Copy qw(copy);
5 my $OBJ   = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
6 my $name = $0;
7 $name =~ s#^(.*)\.PL$#../$1.SH#;
8 my %opt;
9 while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
10  {
11   $opt{$1}=$2;
12   shift(@ARGV);
13  }
14
15 $opt{CONFIG_H} ||= 'config.h';
16
17 my $patchlevel = $opt{INST_VER};
18 $patchlevel =~ s|^[\\/]||;
19 $patchlevel =~ s|~VERSION~|$Config{version}|g;
20 $patchlevel ||= $Config{version};
21 $patchlevel = qq["$patchlevel"];
22
23 open(SH,"<$name") || die "Cannot open $name:$!";
24 while (<SH>)
25  {
26   last if /^sed/;
27  }
28 ($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;
29
30 $file =~ s/^\$(\w+)$/$opt{$1}/g;
31
32 my $str = "sub munge\n{\n";
33
34 while ($pat =~ s/-e\s+'([^']*)'\s*//)
35  {
36   my $e = $1;
37   $e =~ s/\\([\(\)])/$1/g;
38   $e =~ s/\\(\d)/\$$1/g; 
39   $str .= "$e;\n";
40  }
41 $str .= "}\n";
42
43 eval $str;
44
45 die "$str:$@" if $@;
46
47 open(H,">$file.new") || die "Cannot open $file.new:$!";
48 #binmode H;             # no CRs (which cause a spurious rebuild)
49 while (<SH>)
50  {
51   last if /^$term$/o;
52   s/\$([\w_]+)/Config($1)/eg;
53   s/`([^\`]*)`/BackTick($1)/eg;
54   munge();
55   s/\\\$/\$/g;
56   s#/[ *\*]*\*/#/**/#;
57   if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
58    {
59      $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
60    }
61   # incpush() handles archlibs, so disable them
62   elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
63    {
64      $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
65    }
66   print H;
67  }
68 close(H);
69 close(SH);
70
71
72 chmod(0666,"../lib/CORE/config.h");
73 copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
74 chmod(0444,"../lib/CORE/config.h");
75
76 if (!$OBJ && compare("$file.new",$file))
77  {
78   warn "$file has changed\n";
79   chmod(0666,$file);
80   unlink($file);
81   rename("$file.new",$file);
82   #chmod(0444,$file);
83   exit(1);
84  }
85 else
86  {
87   unlink ("$file.new");
88   exit(0);
89  }
90
91 sub Config
92 {
93  my $var = shift;
94  my $val = $Config{$var};
95  $val = 'undef' unless defined $val;
96  $val =~ s/\\/\\\\/g;
97  return $val;
98 }
99
100 sub BackTick
101 {
102  my $cmd = shift;
103  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
104   {
105    local ($data,$pat) = ($1,$2);
106    $data =~ s/\s+/ /g;
107    eval "\$data =~ $pat";
108    return $data;
109   }
110  else
111   {
112    die "Cannot handle \`$cmd\`";
113   }
114  return $cmd;
115 }