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