expandvars.pl

   1 #! /usr/bin/perl -w
   2 use diagnostics;
   3 use strict;
   4 use Getopt::Long;
   5
   6 sub usage ()
   7 {
   8     print STDERR <<"EOF";
   9 Usage: $0 [options] source-filename
  10 EOF
  11     print STDERR <<'EOF';
  12 where options are:
  13
  14   -h, -?, --help            print this message
  15   -c,     --conf FILENAME   use FILENAME as configuration file, default
  16                             '.headers'
  17   -d,     --directory DIR   change to directory DIR
  18   -s,     --suffix SUFFIX   use SUFFIX for all output filenames, default null
  19
  20 The configuration file is of the following form:
  21
  22 # Comments are preceded by hashes and extend to the end of the line.
  23 # List of names of parameters to be substituted (as $param1$, $param2$,
  24 # etc.) in order.
  25 param1 param2 ...
  26
  27 # Multiple records, one per line.
  28 # Each record consists of an output filename (automatically used as the value
  29 # of the name parameter; suffix will be added if present) followed by a list of
  30 # parameter values. Fields are space-separated. Double quotes (") may be used
  31 # to delimit fields containing spaces, and double quotes themselves may be
  32 # escaped with backslashes.
  33
  34 EOF
  35     exit;
  36 }
  37
  38 my %opts = (conf => '.headers', directory => '', suffix => '');
  39 GetOptions(\%opts, 'help|h|?', 'conf|c=s', 'directory|d=s', 'suffix|s=s');
  40 my $source = shift;
  41 usage unless defined $source;
  42
  43 usage if $opts{'help'};
  44 chdir $opts{'directory'} if $opts{'directory'};
  45 open CONF, $opts{'conf'} or
  46     die "Can't open configuration file " . $opts{'conf'} . ": $!";
  47 -r $source or die "Can't read source file $source: $!";
  48
  49 my @params;
  50 while (<CONF>)
  51 {
  52     next if /^#/ || /^\s+/;
  53     @params = split;
  54     last;
  55 }
  56
  57 usage unless defined @params && $#params >= 0;
  58
  59 # Eek. This matches the next (optionally double-quoted) string on the line.
  60 my $stringre = qr/\s*("(?:[^\\]|\\.)*?"|(?:[^\\]|\\.)+?)(?:\s|$)/;
  61 while (<CONF>)
  62 {
  63     next if /^#/ || /^\s+/;
  64     my $confline = $_;
  65     next unless $confline =~ /$stringre/g;
  66     my $target = $1;
  67     my %values = (name => $target);
  68     my @conffields = ($confline =~ /\G$stringre/g);
  69     my $offset = 0;
  70     for (my $i = 0; $i + $offset <= $#params && $i <= $#conffields; $i++)
  71     {
  72         $offset++ while $params[$i + $offset] eq 'name';
  73         last if $i + $offset > $#params;
  74         my $value = $conffields[$i];
  75         $value =~ s/^"(.*)"$/$1/;
  76         $value =~ s/\\(.)/$1/g;
  77         $values{$params[$i + $offset]} = $value;
  78     }
  79
  80     # Do the substitution in the source file.
  81     open SOURCE, $source or die "Can't open source file $source: $!";
  82     open TARGET, ">$target" . $opts{'suffix'} or
  83         die "Can't open target file $target" . $opts{'suffix'} . ": $!";
  84     select TARGET;
  85     while (<SOURCE>)
  86     {
  87         foreach my $param (keys %values)
  88         {
  89             my $value = $values{$param};
  90             s/\$\Q$param\E\$/$value/g;
  91         }
  92         s/\$\$/\$/g;
  93         print;
  94     }
  95     select STDOUT;
  96     close TARGET;
  97 }
  98