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    }
  42   print H;
  43  }
  44 print H "#include <win32.h>
  45 #ifndef DEBUGGING
  46 #define DEBUGGING
  47 #endif
  48 ";
  49 close(H);
  50 close(SH);
  51
  52
  53 chmod(0666,"../lib/CORE/config.h");
  54 copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
  55 chmod(0444,"../lib/CORE/config.h");
  56
  57 if (compare("$file.new",$file))
  58  {
  59   warn "$file has changed\n";
  60   chmod(0666,$file);
  61   unlink($file);
  62   rename("$file.new",$file);
  63   chmod(0444,$file);
  64   exit(1);
  65  }
  66
  67 sub Config
  68 {
  69  my $var = shift;
  70  my $val = $Config{$var};
  71  $val = 'undef' unless defined $val;
  72  $val =~ s/\\/\\\\/g;
  73  return $val;
  74 }
  75
  76 sub BackTick
  77 {
  78  my $cmd = shift;
  79  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
  80   {
  81    local ($data,$pat) = ($1,$2);
  82    $data =~ s/\s+/ /g;
  83    eval "\$data =~ $pat";
  84    return $data;
  85   }
  86  else
  87   {
  88    die "Cannot handle \`$cmd\`";
  89   }
  90  return $cmd;
  91 }