win32/config_h.PL

   1 #
   2 use Config;
   3 use File::Compare qw(compare);
   4 use File::Copy qw(copy);
   5 my $name = $0;
   6 $name =~ s#^(.*)\.PL$#../$1.SH#;
   7 open(SH,"<$name") || die "Cannot open $name:$!";
   8 while (<SH>)
   9  {
  10   last if /^sed/;
  11  }
  12 ($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;
  13
  14 my $str = "sub munge\n{\n";
  15
  16 while ($pat =~ s/-e\s+'([^']*)'\s*//)
  17  {
  18   my $e = $1;
  19   $e =~ s/\\([\(\)])/$1/g;
  20   $e =~ s/\\(\d)/\$$1/g;
  21   $str .= "$e;\n";
  22  }
  23 $str .= "}\n";
  24
  25 eval $str;
  26
  27 die "$str:$@" if $@;
  28
  29 open(H,">$file.new") || die "Cannot open $file.new:$!";
  30 while (<SH>)
  31  {
  32   last if /^$term$/o;
  33   s/\$([\w_]+)/Config($1)/eg;
  34   s/`([^\`]*)`/BackTick($1)/eg;
  35   munge();
  36   s/\\\$/\$/g;
  37   s#/[ *\*]*\*/#/**/#;
  38   if (/^\s*#define\s+ARCHLIB_EXP/)
  39    {
  40      $_ = "#define ARCHLIB_EXP (win32PerlLibPath())\t/**/\n"
  41         . "#define APPLLIB_EXP (win32SiteLibPath())\t/**/\n";
  42    }
  43   print H;
  44  }
  45 print H "#include <win32.h>
  46 #ifndef DEBUGGING
  47 #define DEBUGGING
  48 #endif
  49 ";
  50 close(H);
  51 close(SH);
  52
  53
  54 chmod(0666,"../lib/CORE/config.h");
  55 copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
  56 chmod(0444,"../lib/CORE/config.h");
  57
  58 if (compare("$file.new",$file))
  59  {
  60   warn "$file has changed\n";
  61   chmod(0666,$file);
  62   unlink($file);
  63   rename("$file.new",$file);
  64   chmod(0444,$file);
  65   exit(1);
  66  }
  67
  68 sub Config
  69 {
  70  my $var = shift;
  71  my $val = $Config{$var};
  72  $val = 'undef' unless defined $val;
  73  $val =~ s/\\/\\\\/g;
  74  return $val;
  75 }
  76
  77 sub BackTick
  78 {
  79  my $cmd = shift;
  80  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
  81   {
  82    local ($data,$pat) = ($1,$2);
  83    $data =~ s/\s+/ /g;
  84    eval "\$data =~ $pat";
  85    return $data;
  86   }
  87  else
  88   {
  89    die "Cannot handle \`$cmd\`";
  90   }
  91  return $cmd;
  92 }