home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / win32 / config_sh.PL < prev    next >
Text File  |  2000-03-18  |  2KB  |  84 lines
  1. # take a semicolon separated path list and turn it into a quoted
  2. # list of paths that Text::Parsewords will grok
  3. sub mungepath {
  4.     my $p = shift;
  5.     # remove leading/trailing semis/spaces
  6.     $p =~ s/^[ ;]+//;
  7.     $p =~ s/[ ;]+$//;
  8.     $p =~ s/'/"/g;
  9.     my @p = map { $_ = "\"$_\"" if /\s/ and !/^".*"$/; $_ } split /;/, $p;
  10.     return join(' ', @p);
  11. }
  12.  
  13. # generate an array of option strings from command-line args
  14. # or an option file
  15. #    -- added by BKS, 10-17-1999 to fix command-line overflow problems
  16. sub loadopts {
  17.     if ($ARGV[0] =~ /--cfgsh-option-file/) {
  18.     shift @ARGV;
  19.     my $optfile = shift @ARGV;
  20.     local (*F);
  21.     open OPTF, $optfile or die "Can't open $optfile: $!\n";
  22.     my @opts;
  23.     chomp(my $line = <OPTF>);
  24.     my @vars = split(/\t+~\t+/, $line);
  25.     for (@vars) {
  26.         push(@opts, $_) unless (/^\s*$/);
  27.     }
  28.     close OPTF;
  29.     return \@opts;
  30.     }
  31.     else {
  32.     return \@ARGV;
  33.     }
  34. }
  35.  
  36. my %opt;
  37. my $optref = loadopts();
  38. while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) {
  39.     $opt{$1}=$2;
  40.     shift(@{$optref});
  41. }
  42.  
  43. my $pl_h = '../patchlevel.h';
  44.  
  45. if (-e $pl_h) {
  46.     open PL, "<$pl_h" or die "Can't open $pl_h: $!";
  47.     while (<PL>) {
  48.     if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) {
  49.         $opt{$1} = $2;
  50.     }
  51.     }
  52.     close PL;
  53. }
  54. else {
  55.     die "Can't find $pl_h: $!";
  56. }
  57. $opt{VERSION} = "$opt{PERL_REVISION}.$opt{PERL_VERSION}.$opt{PERL_SUBVERSION}";
  58. $opt{INST_VER} =~ s|~VERSION~|$opt{VERSION}|g;
  59.  
  60. $opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'};
  61. $opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
  62.     unless $opt{'cf_email'};
  63. $opt{'usemymalloc'} = 'y' if $opt{'d_mymalloc'} eq 'define';
  64.  
  65. $opt{libpth} = mungepath($opt{libpth}) if exists $opt{libpth};
  66. $opt{incpath} = mungepath($opt{incpath}) if exists $opt{incpath};
  67.  
  68. while (<>) {
  69.     s/~([\w_]+)~/$opt{$1}/g;
  70.     if (/^([\w_]+)=(.*)$/) {
  71.     my($k,$v) = ($1,$2);
  72.     # this depends on cf_time being empty in the template (or we'll
  73.     # get a loop)
  74.     if ($k eq 'cf_time') {
  75.         $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/;
  76.     }
  77.     elsif (exists $opt{$k}) {
  78.         $_ = "$k='$opt{$k}'\n";
  79.     }
  80.     }
  81.     print;
  82. }
  83.  
  84.