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 ";
  58 close(H);
  59 close(SH);
  60
  61
  62 chmod(0666,"../lib/CORE/config.h");
  63 copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
  64 chmod(0444,"../lib/CORE/config.h");
  65
  66 if (compare("$file.new",$file))
  67  {
  68   warn "$file has changed\n";
  69   chmod(0666,$file);
  70   unlink($file);
  71   rename("$file.new",$file);
  72   chmod(0444,$file);
  73   exit(1);
  74  }
  75
  76 sub Config
  77 {
  78  my $var = shift;
  79  my $val = $Config{$var};
  80  $val = 'undef' unless defined $val;
  81  $val =~ s/\\/\\\\/g;
  82  return $val;
  83 }
  84
  85 sub BackTick
  86 {
  87  my $cmd = shift;
  88  if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
  89   {
  90    local ($data,$pat) = ($1,$2);
  91    $data =~ s/\s+/ /g;
  92    eval "\$data =~ $pat";
  93    return $data;
  94   }
  95  else
  96   {
  97    die "Cannot handle \`$cmd\`";
  98   }
  99  return $cmd;
 100 }