home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / win32 / config_h.PL < prev    next >
Text File  |  2000-03-18  |  2KB  |  111 lines
  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. my $patchlevel = $opt{INST_VER};
  15. $patchlevel =~ s|^[\\/]||;
  16. $patchlevel =~ s|~VERSION~|$Config{version}|g;
  17. $patchlevel ||= $Config{version};
  18. $patchlevel = qq["$patchlevel"];
  19.  
  20. open(SH,"<$name") || die "Cannot open $name:$!";
  21. while (<SH>)
  22.  {
  23.   last if /^sed/;
  24.  }
  25. ($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;
  26.  
  27. my $str = "sub munge\n{\n";
  28.  
  29. while ($pat =~ s/-e\s+'([^']*)'\s*//)
  30.  {
  31.   my $e = $1;
  32.   $e =~ s/\\([\(\)])/$1/g;
  33.   $e =~ s/\\(\d)/\$$1/g; 
  34.   $str .= "$e;\n";
  35.  }
  36. $str .= "}\n";
  37.  
  38. eval $str;
  39.  
  40. die "$str:$@" if $@;
  41.  
  42. open(H,">$file.new") || die "Cannot open $file.new:$!";
  43. binmode H;        # no CRs (which cause a spurious rebuild)
  44. while (<SH>)
  45.  {
  46.   last if /^$term$/o;
  47.   s/\$([\w_]+)/Config($1)/eg;
  48.   s/`([^\`]*)`/BackTick($1)/eg;
  49.   munge();
  50.   s/\\\$/\$/g;
  51.   s#/[ *\*]*\*/#/**/#;
  52.   if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
  53.    {
  54.      $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
  55.    }
  56.   # incpush() handles archlibs, so disable them
  57.   elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
  58.    {
  59.      $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
  60.    }
  61.   print H;
  62.  }
  63. close(H);
  64. close(SH);
  65.  
  66.  
  67. chmod(0666,"../lib/CORE/config.h");
  68. copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
  69. chmod(0444,"../lib/CORE/config.h");
  70.  
  71. if (!$OBJ && compare("$file.new",$file))
  72.  {
  73.   warn "$file has changed\n";
  74.   chmod(0666,$file);
  75.   unlink($file);
  76.   rename("$file.new",$file);
  77.   #chmod(0444,$file);
  78.   exit(1);
  79.  }
  80. else
  81.  {
  82.   unlink ("$file.new");
  83.   exit(0);
  84.  }
  85.  
  86. sub Config
  87. {
  88.  my $var = shift;
  89.  my $val = $Config{$var};
  90.  $val = 'undef' unless defined $val;
  91.  $val =~ s/\\/\\\\/g;
  92.  return $val;
  93. }
  94.  
  95. sub BackTick
  96. {
  97.  my $cmd = shift;
  98.  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
  99.   {
  100.    local ($data,$pat) = ($1,$2);
  101.    $data =~ s/\s+/ /g;
  102.    eval "\$data =~ $pat";
  103.    return $data;
  104.   }
  105.  else
  106.   {
  107.    die "Cannot handle \`$cmd\`";
  108.   }
  109.  return $cmd;
  110. }
  111.