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 # We actually expect to get the following hash tables from configdata:
  14 #
  15 #    %config
  16 #    %target
  17 #    %withargs
  18 #    %unified_info
  19 #
  20 # We just do a minimal test to see that we got what we expected.
  21 # $config{target} must exist as an absolute minimum.
  22 die "You must run this script with -Mconfigdata\n" if !exists($config{target});
  23
  24 # Make a subclass of Text::Template to override append_text_to_result,
  25 # as recommended here:
  26 #
  27 # http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks
  28
  29 package OpenSSL::Template;
  30
  31 # Because we know that Text::Template isn't a core Perl module, we use
  32 # a fallback in case it's not installed on the system
  33 use File::Basename;
  34 use File::Spec::Functions;
  35 use lib catdir(dirname(__FILE__));
  36 use with_fallback qw(Text::Template);
  37
  38 #use parent qw/Text::Template/;
  39 use vars qw/@ISA/;
  40 push @ISA, qw/Text::Template/;
  41
  42 # Override constructor
  43 sub new {
  44     my ($class) = shift;
  45
  46     # Call the constructor of the parent class, Person.
  47     my $self = $class->SUPER::new( @_ );
  48     # Add few more attributes
  49     $self->{_output_off}   = 0; # Default to output hunks
  50     bless $self, $class;
  51     return $self;
  52 }
  53
  54 sub append_text_to_output {
  55     my $self = shift;
  56
  57     if ($self->{_output_off} == 0) {
  58         $self->SUPER::append_text_to_output(@_);
  59     }
  60
  61     return;
  62 }
  63
  64 sub output_reset_on {
  65     my $self = shift;
  66     $self->{_output_off} = 0;
  67 }
  68
  69 sub output_on {
  70     my $self = shift;
  71     if (--$self->{_output_off} < 0) {
  72         $self->{_output_off} = 0;
  73     }
  74 }
  75
  76 sub output_off {
  77     my $self = shift;
  78     $self->{_output_off}++;
  79 }
  80
  81 # Come back to main
  82
  83 package main;
  84
  85 # Helper functions for the templates #################################
  86
  87 # It might be practical to quotify some strings and have them protected
  88 # from possible harm.  These functions primarly quote things that might
  89 # be interpreted wrongly by a perl eval.
  90
  91 # quotify1 STRING
  92 # This adds quotes (") around the given string, and escapes any $, @, \,
  93 # " and ' by prepending a \ to them.
  94 sub quotify1 {
  95     my $s = shift @_;
  96     $s =~ s/([\$\@\\"'])/\\$1/g;
  97     '"'.$s.'"';
  98 }
  99
 100 # quotify_l LIST
 101 # For each defined element in LIST (i.e. elements that aren't undef), have
 102 # it quotified with 'quotofy1'
 103 sub quotify_l {
 104     map {
 105         if (!defined($_)) {
 106             ();
 107         } else {
 108             quotify1($_);
 109         }
 110     } @_;
 111 }
 112
 113 # Error reporter #####################################################
 114
 115 # The error reporter uses %lines to figure out exactly which file the
 116 # error happened and at what line.  Not that the line number may be
 117 # the start of a perl snippet rather than the exact line where it
 118 # happened.  Nothing we can do about that here.
 119
 120 my %lines = ();
 121 sub broken {
 122     my %args = @_;
 123     my $filename = "<STDIN>";
 124     my $deducelines = 0;
 125     foreach (sort keys %lines) {
 126         $filename = $lines{$_};
 127         last if ($_ > $args{lineno});
 128         $deducelines += $_;
 129     }
 130     print STDERR $args{error}," in $filename, fragment starting at line ",$args{lineno}-$deducelines;
 131     undef;
 132 }
 133
 134 # Check options ######################################################
 135
 136 my %opts = ();
 137
 138 # -o ORIGINATOR
 139 #               declares ORIGINATOR as the originating script.
 140 getopt('o', \%opts);
 141
 142 my @autowarntext = ("WARNING: do not edit!",
 143                     "Generated"
 144                     . (defined($opts{o}) ? " by ".$opts{o} : "")
 145                     . (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : ""));
 146
 147 # Template reading ###################################################
 148
 149 # Read in all the templates into $text, while keeping track of each
 150 # file and its size in lines, to try to help report errors with the
 151 # correct file name and line number.
 152
 153 my $prev_linecount = 0;
 154 my $text =
 155     @ARGV
 156     ? join("", map { my $x = "{- output_reset_on() -}".Text::Template::_load_text($_);
 157                      my $linecount = $x =~ tr/\n//;
 158                      $prev_linecount = ($linecount += $prev_linecount);
 159                      $lines{$linecount} = $_;
 160                      $x } @ARGV)
 161     : join("", <STDIN>);
 162
 163 # Engage! ############################################################
 164
 165 # Load the full template (combination of files) into Text::Template
 166 # and fill it up with our data.  Output goes directly to STDOUT
 167
 168 my $template = OpenSSL::Template->new(TYPE => 'STRING', SOURCE => $text );
 169
 170 sub output_reset_on {
 171     $template->output_reset_on();
 172     "";
 173 }
 174 sub output_on {
 175     $template->output_on();
 176     "";
 177 }
 178 sub output_off {
 179     $template->output_off();
 180     "";
 181 }
 182
 183 $template->fill_in(OUTPUT => \*STDOUT,
 184                    HASH => { config => \%config,
 185                              target => \%target,
 186                              disabled => \%disabled,
 187                              withargs => \%withargs,
 188                              unified_info => \%unified_info,
 189                              autowarntext => \@autowarntext,
 190                              quotify1 => \&quotify1,
 191                              quotify_l => \&quotify_l,
 192                              output_reset_on => \&output_reset_on,
 193                              output_on => \&output_on,
 194                              output_off => \&output_off },
 195                    DELIMITERS => [ "{-", "-}" ],
 196                    BROKEN => \&broken);