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
CommitLineData
137443ea
PP
1#
2use Config;
3use File::Compare qw(compare);
4use File::Copy qw(copy);
01f988be 5my $OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
137443ea
PP
6my $name = $0;
7$name =~ s#^(.*)\.PL$#../$1.SH#;
e5a95ffb
GS
8my %opt;
9while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
10 {
11 $opt{$1}=$2;
12 shift(@ARGV);
13 }
38121b9e
GS
14
15$opt{CONFIG_H} ||= 'config.h';
16
e5a95ffb 17my $patchlevel = $opt{INST_VER};
66aa1127 18$patchlevel =~ s|^[\\/]||;
273cf8d1
GS
19$patchlevel =~ s|~VERSION~|$Config{version}|g;
20$patchlevel ||= $Config{version};
e5a95ffb
GS
21$patchlevel = qq["$patchlevel"];
22
137443ea
PP
23open(SH,"<$name") || die "Cannot open $name:$!";
24while (<SH>)
25 {
26 last if /^sed/;
27 }
28($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;
29
38121b9e
GS
30$file =~ s/^\$(\w+)$/$opt{$1}/g;
31
137443ea
PP
32my $str = "sub munge\n{\n";
33
34while ($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
43eval $str;
44
45die "$str:$@" if $@;
46
47open(H,">$file.new") || die "Cannot open $file.new:$!";
8c8a4ace 48#binmode H; # no CRs (which cause a spurious rebuild)
137443ea
PP
49while (<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#/[ *\*]*\*/#/**/#;
4ea817c6 57 if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
acbc2db6 58 {
c5be433b 59 $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
acbc2db6 60 }
e5a95ffb 61 # incpush() handles archlibs, so disable them
4ea817c6 62 elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
acbc2db6 63 {
e5a95ffb 64 $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
137443ea
PP
65 }
66 print H;
67 }
137443ea
PP
68close(H);
69close(SH);
70
71
72chmod(0666,"../lib/CORE/config.h");
73copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
74chmod(0444,"../lib/CORE/config.h");
75
01f988be 76if (!$OBJ && compare("$file.new",$file))
137443ea
PP
77 {
78 warn "$file has changed\n";
79 chmod(0666,$file);
80 unlink($file);
81 rename("$file.new",$file);
924b3ec4 82 #chmod(0444,$file);
137443ea
PP
83 exit(1);
84 }
01f988be
GS
85else
86 {
87 unlink ("$file.new");
88 exit(0);
89 }
137443ea
PP
90
91sub 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
100sub 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}