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