dofile.pl 5.2 KB

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