1#!perl -w 2use strict; 3 4BEGIN { warn "Running ".__FILE__."\n" }; 5BEGIN 6 { 7 require "Config.pm"; 8 die "Config.pm:$@" if $@; 9 Config->import; 10 } 11use File::Compare qw(compare); 12use File::Copy qw(copy); 13use File::Basename qw(fileparse); 14 15my ($name, $dir) = fileparse($0); 16$name =~ s#^(.*)\.PL$#../$1.SH#; 17my %opt; 18while (@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 27warn "Writing $opt{CONFIG_H}\n"; 28 29open(SH,"<$name") || die "Cannot open $name:$!"; 30while (<SH>) 31 { 32 last if /^\s*sed/; 33 } 34my($term,$file,$pat) = /^\s*sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/; 35 36$file =~ s/^\$(\w+)$/$opt{$1}/g; 37 38my $str = "sub munge\n{\n"; 39 40while ($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 49eval $str; 50 51die "$str:$@" if $@; 52 53open(H,">$file.new") || die "Cannot open $file.new:$!"; 54binmode(H); 55while (<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 } 79close(H); 80close(SH); 81 82 83chmod(0666,"$opt{CORE_DIR}/$opt{CONFIG_H}"); 84copy("$file.new","$opt{CORE_DIR}/$opt{CONFIG_H}") || die "Cannot copy:$!"; 85chmod(0444,"$opt{CORE_DIR}/$opt{CONFIG_H}"); 86 87if (compare("$file.new",$file)) 88 { 89 warn "$file has changed\n"; 90 chmod(0666,$file); 91 unlink($file); 92 rename("$file.new",$file); 93 exit(1); 94 } 95else 96 { 97 unlink ("$file.new"); 98 exit(0); 99 } 100 101sub Config 102{ 103 my $var = shift; 104 my $val = $Config{$var}; 105 $val = 'undef' unless defined $val; 106 $val =~ s/\\/\\\\/g; 107 return $val; 108} 109 110sub BackTick 111{ 112 my $cmd = shift; 113 if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/) 114 { 115 my($data,$pat) = ($1,$2); 116 $data =~ s/\s+/ /g; 117 eval "\$data =~ $pat"; 118 return $data; 119 } 120 else 121 { 122 die "Cannot handle \`$cmd\`"; 123 } 124 return $cmd; 125} 126