src/util/ktemplate.pm

   1 # -*- perl -*-
   2
   3 sub usage {
   4     print STDERR "usage: $0 -oOutputFile PARM=value ...\n";
   5     print STDERR "  where acceptable PARM values are:\n";
   6     print STDERR "\t", join(' ', @parms), "\n";
   7     exit(1);
   8 }
   9
  10 %parm = ();
  11 sub run {
  12     my $arg;
  13     my $outfile;
  14     my %allowed_parms = ();
  15
  16     foreach $arg (@parms) { $allowed_parms{$arg} = 1; }
  17
  18     foreach $arg (@ARGV) {
  19         if ($arg =~ /^-o./) {
  20             if (defined $outfile) {
  21                 die "$0: Output file specified multiple times\n";
  22             }
  23             $outfile = substr($arg, 2);
  24         } else {
  25             my @words = split '=', $arg;
  26             if ($#words != 1) {
  27                 print STDERR "$0: $arg : #words = $#words\n";
  28                 &usage;
  29             }
  30             if (!defined $allowed_parms{$words[0]}) {
  31                 print STDERR "$0: Unknown parameter $words[0]\n";
  32                 &usage;
  33             }
  34             $parm{$words[0]} = $words[1];
  35         }
  36     }
  37     my $p;
  38     my $subst = "";
  39     #print "Keys defined: ", join(' ', keys %parm), "\n";
  40     foreach $p (@parms) {
  41         if (!defined $parm{$p}) {
  42             die "$0: No value supplied for parameter $p\n";
  43         }
  44         # XXX More careful quoting of supplied value!
  45         $subst .= "\t\$a =~ s|<$p>|$parm{$p}|go;\n";
  46     }
  47     $subst = "sub do_substitution {\n"
  48         . "\tmy(\$a) = \@_;\n"
  49         . $subst
  50         . "\treturn \$a;\n"
  51         . "}\n"
  52         . "1;";
  53     eval $subst || die;
  54     if (defined $outfile) {
  55         open OUTFILE, ">$outfile" || die;
  56     } else {
  57         print STDERR "$0: No output file specified.\n";
  58         &usage;
  59     }
  60     print OUTFILE "/*\n";
  61     print OUTFILE " * This file is generated, please don't edit it.\n";
  62     print OUTFILE " * script: $0\n";
  63     print OUTFILE " * args:\n *\t", join("\n *\t", @ARGV), "\n";
  64     print OUTFILE " * The rest of this file is copied from a template, with\n";
  65     print OUTFILE " * substitutions.  See the template for copyright info.\n";
  66     print OUTFILE " */\n";
  67     while (<DATA>) {
  68         print OUTFILE &do_substitution($_);
  69     }
  70     close OUTFILE;
  71     exit (0);
  72 }
  73
  74 1;