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