chiark / gitweb /
Remove yet more obsolete programs.
[bin.git] / 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