Mercurial > repo

comparison perl-5.22.2/win32/config_h.PL @ 8045:a16537d2fe07

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author HackBot
date Sat, 14 May 2016 14:54:38 +0000
parents
children
comparison
equal deleted inserted replaced
8044:711c038a7dce 8045:a16537d2fe07
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 binmode(H);
55 while (<SH>)
56 {
57 last if /^$term$/o;
58 s/\$([\w_]+)/Config($1)/eg;
59 s/`([^\`]*)`/BackTick($1)/eg;
60 munge();
61 s/\\\$/\$/g;
62 s#/[ *\*]*\*/#/**/#;
63 s#(.)/\*\*/#$1/ **/# if(/^\/\*/); #avoid "/*" inside comments
64 if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
65 {
66 $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "(PERL_VERSION_STRING, NULL))\t/**/\n";
67 }
68 # incpush() handles archlibs, so disable them
69 elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
70 {
71 $_ = "/*#define ". $1 . "_EXP \"\"\t/ **/\n";
72 }
73 elsif (/^\s*#define\s+CPP(STDIN|RUN)\s+"gcc(.*)"\s*$/)
74 {
75 $_ = "#define CPP" . $1 . " \"" . $opt{ARCHPREFIX} . "gcc" . $2 . "\"\n";
76 }
77 print H;
78 }
79 close(H);
80 close(SH);
81
82 if (compare("$file.new","$opt{CORE_DIR}/$opt{CONFIG_H}")) {
83 chmod(0666,"$opt{CORE_DIR}/$opt{CONFIG_H}");
84 copy("$file.new","$opt{CORE_DIR}/$opt{CONFIG_H}") || die "Cannot copy:$!";
85 chmod(0444,"$opt{CORE_DIR}/$opt{CONFIG_H}");
86 }
87
88 if (compare("$file.new",$file))
89 {
90 warn "$file has changed\n";
91 chmod(0666,$file);
92 unlink($file);
93 rename("$file.new",$file);
94 exit(1);
95 }
96 else
97 {
98 unlink ("$file.new");
99 exit(0);
100 }
101
102 sub Config
103 {
104 my $var = shift;
105 my $val = $Config{$var};
106 $val = 'undef' unless defined $val;
107 $val =~ s/\\/\\\\/g;
108 return $val;
109 }
110
111 sub BackTick
112 {
113 my $cmd = shift;
114 if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
115 {
116 my($data,$pat) = ($1,$2);
117 $data =~ s/\s+/ /g;
118 eval "\$data =~ $pat";
119 return $data;
120 }
121 else
122 {
123 die "Cannot handle \`$cmd\`";
124 }
125 return $cmd;
126 }