Home | History | Annotate | Line # | Download | only in OpenSSL
      1 #! /usr/bin/env perl
      2 # Copyright 2016-2021 The OpenSSL Project Authors. All Rights Reserved.
      3 #
      4 # Licensed under the Apache License 2.0 (the "License").  You may not use
      5 # this file except in compliance with the License.  You can obtain a copy
      6 # in the file LICENSE in the source distribution or at
      7 # https://www.openssl.org/source/license.html
      8 
      9 # Implements the functionality to read one or more template files and run
     10 # them through Text::Template
     11 
     12 package OpenSSL::Template;
     13 
     14 =head1 NAME
     15 
     16 OpenSSL::Template - a private extension of Text::Template
     17 
     18 =head1 DESCRIPTION
     19 
     20 This provides exactly the functionality from Text::Template, with the
     21 following additions:
     22 
     23 =over 4
     24 
     25 =item *
     26 
     27 The template perl code delimiters (given with the C<DELIMITER> option)
     28 are set to C<{-> and C<-}> by default.
     29 
     30 =item *
     31 
     32 A few extra functions are offered to be used by the template perl code, see
     33 L</Functions>.
     34 
     35 =back
     36 
     37 =cut
     38 
     39 use File::Basename;
     40 use File::Spec::Functions;
     41 use Text::Template 1.46;
     42 
     43 our @ISA = qw(Text::Template);  # parent
     44 
     45 sub tmpl_error {
     46     my (%err_dict) = @_;
     47 
     48     $ERROR = $err_dict{"error"};
     49 
     50     return undef;
     51 }
     52 
     53 sub new {
     54     my $class = shift;
     55 
     56     # Call the constructor of the parent class.
     57     my $self = $class->SUPER::new(DELIMITERS => [ '{-', '-}'],
     58                                   @_ );
     59 
     60     # Add few more attributes
     61     $self->{_output_off}   = 0; # Default to output hunks
     62 
     63     return bless $self, $class;
     64 }
     65 
     66 sub fill_in {
     67     my $self = shift;
     68     my %opts = @_;
     69     my %hash = ( %{$opts{HASH}} );
     70     delete $opts{HASH};
     71 
     72     $self->SUPER::fill_in(HASH => { quotify1 => \&quotify1,
     73                                     quotify_l => \&quotify_l,
     74                                     output_on => sub { $self->output_on() },
     75                                     output_off => sub { $self->output_off() },
     76                                     %hash },
     77                           BROKEN => \&tmpl_error,
     78                           %opts);
     79 }
     80 
     81 =head2 Functions
     82 
     83 =cut
     84 
     85 # Override Text::Template's append_text_to_result, as recommended here:
     86 #
     87 # http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks
     88 sub append_text_to_output {
     89     my $self = shift;
     90 
     91     if ($self->{_output_off} == 0) {
     92         $self->SUPER::append_text_to_output(@_);
     93     }
     94 
     95     return;
     96 }
     97 
     98 =begin comment
     99 
    100 We lie about the OO nature of output_on() and output_off(), 'cause that's
    101 not how we pass them, see the HASH option used in fill_in() above
    102 
    103 =end comment
    104 
    105 =over 4
    106 
    107 =item output_on()
    108 
    109 =item output_off()
    110 
    111 Switch on or off template output.  Here's an example usage:
    112 
    113 =over 4
    114 
    115  {- output_off() if CONDITION -}
    116  whatever
    117  {- output_on() if CONDITION -}
    118 
    119 =back
    120 
    121 In this example, C<whatever> will only become part of the template output
    122 if C<CONDITION> is true.
    123 
    124 =back
    125 
    126 =cut
    127 
    128 sub output_on {
    129     my $self = shift;
    130     if (--$self->{_output_off} < 0) {
    131         $self->{_output_off} = 0;
    132     }
    133 }
    134 
    135 sub output_off {
    136     my $self = shift;
    137     $self->{_output_off}++;
    138 }
    139 
    140 # Helper functions for the templates #################################
    141 
    142 =head1 SEE ALSO
    143 
    144 L<Text::Template>
    145 
    146 =head1 AUTHORS
    147 
    148 Richard Levitte E<lt>levitte (at] openssl.orgE<gt>
    149 
    150 =head1 COPYRIGHT
    151 
    152 Copyright 2016-2021 The OpenSSL Project Authors. All Rights Reserved.
    153 
    154 Licensed under the Apache License 2.0 (the "License").  You may not use
    155 this file except in compliance with the License.  You can obtain a copy
    156 in the file LICENSE in the source distribution or at
    157 L<https://www.openssl.org/source/license.html>.
    158 
    159 =cut
    160