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 binmode H;              # no CRs (which cause a spurious rebuild)
  31 while (<SH>)
  32  {
  33   last if /^$term$/o;
  34   s/\$([\w_]+)/Config($1)/eg;
  35   s/`([^\`]*)`/BackTick($1)/eg;
  36   munge();
  37   s/\\\$/\$/g;
  38   s#/[ *\*]*\*/#/**/#;
  39   if (/^\s*#define\s+ARCHLIB_EXP/)
  40    {
  41      $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n";
  42    }
  43   if (/^\s*#define\s+PRIVLIB_EXP/)
  44    {
  45      $_ = "#define PRIVLIB_EXP (win32_perllib_path(NULL))\t/**/\n"
  46    }
  47   if (/^\s*#define\s+SITEARCH_EXP/)
  48    {
  49      $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n";
  50    }
  51   if (/^\s*#define\s+SITELIB_EXP/)
  52    {
  53      $_ = "#define SITELIB_EXP (win32_perllib_path(\"site\",NULL))\t/**/\n";
  54    }
  55   print H;
  56  }
  57 print H "#include <win32.h>
  58 ";
  59 close(H);
  60 close(SH);
  61
  62
  63 chmod(0666,"../lib/CORE/config.h");
  64 copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
  65 chmod(0444,"../lib/CORE/config.h");
  66
  67 if (compare("$file.new",$file))
  68  {
  69   warn "$file has changed\n";
  70   chmod(0666,$file);
  71   unlink($file);
  72   rename("$file.new",$file);
  73   #chmod(0444,$file);
  74   exit(1);
  75  }
  76
  77 sub Config
  78 {
  79  my $var = shift;
  80  my $val = $Config{$var};
  81  $val = 'undef' unless defined $val;
  82  $val =~ s/\\/\\\\/g;
  83  return $val;
  84 }
  85
  86 sub BackTick
  87 {
  88  my $cmd = shift;
  89  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
  90   {
  91    local ($data,$pat) = ($1,$2);
  92    $data =~ s/\s+/ /g;
  93    eval "\$data =~ $pat";
  94    return $data;
  95   }
  96  else
  97   {
  98    die "Cannot handle \`$cmd\`";
  99   }
 100  return $cmd;
 101 }