util/dofile.pl

   1 #! /usr/bin/perl
   2 #
   3 # Reads one or more template files and runs it through Text::Template
   4 #
   5 # It is assumed that this scripts is called with -Mconfigdata, a module
   6 # that holds configuration data in %config
   7
   8 use strict;
   9 use warnings;
  10
  11 use Getopt::Std;
  12
  13 # Because we know that Text::Template isn't a core Perl module, we use
  14 # a fallback in case it's not installed on the system
  15 use File::Basename;
  16 use File::Spec::Functions;
  17 use lib catdir(dirname(__FILE__));
  18 use with_fallback qw(Text::Template);
  19
  20 # We actually expect to get the following hash tables from configdata:
  21 #
  22 #    %config
  23 #    %target
  24 #    %withargs
  25 #
  26 # We just do a minimal test to see that we got what we expected.
  27 # $config{target} must exist as an absolute minimum.
  28 die "You must run this script with -Mconfigdata\n" if !exists($config{target});
  29
  30 # Helper functions for the templates #################################
  31
  32 # It might be practical to quotify some strings and have them protected
  33 # from possible harm.  These functions primarly quote things that might
  34 # be interpreted wrongly by a perl eval.
  35
  36 # quotify1 STRING
  37 # This adds quotes (") around the given string, and escapes any $, @, \,
  38 # " and ' by prepending a \ to them.
  39 sub quotify1 {
  40     my $s = shift @_;
  41     $s =~ s/([\$\@\\"'])/\\$1/g;
  42     '"'.$s.'"';
  43 }
  44
  45 # quotify_l LIST
  46 # For each defined element in LIST (i.e. elements that aren't undef), have
  47 # it quotified with 'quotofy1'
  48 sub quotify_l {
  49     map {
  50         if (!defined($_)) {
  51             ();
  52         } else {
  53             quotify1($_);
  54         }
  55     } @_;
  56 }
  57
  58 # Error reporter #####################################################
  59
  60 # The error reporter uses %lines to figure out exactly which file the
  61 # error happened and at what line.  Not that the line number may be
  62 # the start of a perl snippet rather than the exact line where it
  63 # happened.  Nothing we can do about that here.
  64
  65 my %lines = ();
  66 sub broken {
  67     my %args = @_;
  68     my $filename = "<STDIN>";
  69     my $deducelines = 0;
  70     foreach (sort keys %lines) {
  71         $filename = $lines{$_};
  72         last if ($_ > $args{lineno});
  73         $deducelines += $_;
  74     }
  75     print STDERR $args{error}," in $filename, fragment starting at line ",$args{lineno}-$deducelines;
  76     undef;
  77 }
  78
  79 # Check options ######################################################
  80
  81 my %opts = ();
  82
  83 # -o ORIGINATOR
  84 #               declares ORIGINATOR as the originating script.
  85 getopt('o', \%opts);
  86
  87 my @autowarntext = ("WARNING: do not edit!",
  88                     "Generated"
  89                     . (defined($opts{o}) ? " by ".$opts{o} : "")
  90                     . (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : ""));
  91
  92 # Template reading ###################################################
  93
  94 # Read in all the templates into $text, while keeping track of each
  95 # file and its size in lines, to try to help report errors with the
  96 # correct file name and line number.
  97
  98 my $prev_linecount = 0;
  99 my $text =
 100     @ARGV
 101     ? join("", map { my $x = Text::Template::_load_text($_);
 102                      my $linecount = $x =~ tr/\n//;
 103                      $prev_linecount = ($linecount += $prev_linecount);
 104                      $lines{$linecount} = $_;
 105                      $x } @ARGV)
 106     : join("", <STDIN>);
 107
 108 # Engage! ############################################################
 109
 110 # Load the full template (combination of files) into Text::Template
 111 # and fill it up with our data.  Output goes directly to STDOUT
 112
 113 my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $text );
 114 $template->fill_in(OUTPUT => \*STDOUT,
 115                    HASH => { config => \%config,
 116                              target => \%target,
 117                              withargs => \%withargs,
 118                              autowarntext => \@autowarntext,
 119                              quotify1 => \&quotify1,
 120                              quotify_l => \&quotify_l },
 121                    DELIMITERS => [ "{-", "-}" ],
 122                    BROKEN => \&broken);