diff options
Diffstat (limited to 'util')
-rw-r--r-- | util/perl/OpenSSL/Template.pm | 45 | ||||
-rw-r--r-- | util/perl/OpenSSL/Util.pm | 136 |
2 files changed, 134 insertions, 47 deletions
diff --git a/util/perl/OpenSSL/Template.pm b/util/perl/OpenSSL/Template.pm index ed89d15085..bed13d20f9 100644 --- a/util/perl/OpenSSL/Template.pm +++ b/util/perl/OpenSSL/Template.pm @@ -130,51 +130,6 @@ sub output_off { # Helper functions for the templates ################################# -# It might be practical to quotify some strings and have them protected -# from possible harm. These functions primarily quote things that might -# be interpreted wrongly by a perl eval. - -# NOTE THAT THESE AREN'T CLASS METHODS! - -=over 4 - -=item quotify1 STRING - -This adds quotes (") around the given string, and escapes any $, @, \, -" and ' by prepending a \ to them. - -=back - -=cut - -sub quotify1 { - my $s = shift @_; - $s =~ s/([\$\@\\"'])/\\$1/g; - '"'.$s.'"'; -} - -=over 4 - -=item quotify_l LIST - -For each defined element in LIST (i.e. elements that aren't undef), have -it quotified with 'quotify1'. -Undefined elements are ignored. - -=back - -=cut - -sub quotify_l { - map { - if (!defined($_)) { - (); - } else { - quotify1($_); - } - } @_; -} - =head1 SEE ALSO L<Text::Template> diff --git a/util/perl/OpenSSL/Util.pm b/util/perl/OpenSSL/Util.pm index 1c8c6afa44..8b3743aa2a 100644 --- a/util/perl/OpenSSL/Util.pm +++ b/util/perl/OpenSSL/Util.pm @@ -6,7 +6,7 @@ # in the file LICENSE in the source distribution or at # https://www.openssl.org/source/license.html -package OpenSSL::Ordinals; +package OpenSSL::Util; use strict; use warnings; @@ -16,7 +16,7 @@ use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.1"; @ISA = qw(Exporter); -@EXPORT = qw(cmp_versions); +@EXPORT = qw(cmp_versions quotify1 quotify_l dump_data); @EXPORT_OK = qw(); =head1 NAME @@ -85,4 +85,136 @@ sub cmp_versions { return $verdict; } +# It might be practical to quotify some strings and have them protected +# from possible harm. These functions primarily quote things that might +# be interpreted wrongly by a perl eval. + +=over 4 + +=item quotify1 STRING + +This adds quotes (") around the given string, and escapes any $, @, \, +" and ' by prepending a \ to them. + +=back + +=cut + +sub quotify1 { + my $s = shift @_; + $s =~ s/([\$\@\\"'])/\\$1/g; + '"'.$s.'"'; +} + +=over 4 + +=item quotify_l LIST + +For each defined element in LIST (i.e. elements that aren't undef), have +it quotified with 'quotify1'. +Undefined elements are ignored. + +=cut + +sub quotify_l { + map { + if (!defined($_)) { + (); + } else { + quotify1($_); + } + } @_; +} + +=item dump_data REF, OPTS + +Dump the data from REF into a string that can be evaluated into the same +data by Perl. + +OPTS is the rest of the arguments, expected to be pairs formed with C<< => >>. +The following OPTS keywords are understood: + +=over 4 + +=item B<delimiters =E<gt> 0 | 1> + +Include the outer delimiter of the REF type in the resulting string if C<1>, +otherwise not. + +=item B<indent =E<gt> num> + +The indentation of the caller, i.e. an initial value. If not given, there +will be no indentation at all, and the string will only be one line. + +=back + +=cut + +sub dump_data { + my $ref = shift; + # Available options: + # indent => callers indentation ( undef for no indentation, + # an integer otherwise ) + # delimiters => 1 if outer delimiters should be added + my %opts = @_; + + my $indent = $opts{indent} // 1; + # Indentation of the whole structure, where applicable + my $nlindent1 = defined $opts{indent} ? "\n" . ' ' x $indent : ' '; + # Indentation of individual items, where applicable + my $nlindent2 = defined $opts{indent} ? "\n" . ' ' x ($indent + 4) : ' '; + my %subopts = (); + + $subopts{delimiters} = 1; + $subopts{indent} = $opts{indent} + 4 if defined $opts{indent}; + + my $product; # Finished product, or reference to a function that + # produces a string, given $_ + # The following are only used when $product is a function reference + my $delim_l; # Left delimiter of structure + my $delim_r; # Right delimiter of structure + my $separator; # Item separator + my @items; # Items to iterate over + + if (ref($ref) eq "ARRAY") { + if (scalar @$ref == 0) { + $product = $opts{delimiters} ? '[]' : ''; + } else { + $product = sub { + dump_data(\$_, %subopts) + }; + $delim_l = ($opts{delimiters} ? '[' : '').$nlindent2; + $delim_r = $nlindent1.($opts{delimiters} ? ']' : ''); + $separator = ",$nlindent2"; + @items = @$ref; + } + } elsif (ref($ref) eq "HASH") { + if (scalar keys %$ref == 0) { + $product = $opts{delimiters} ? '{}' : ''; + } else { + $product = sub { + quotify1($_) . " => " . dump_data($ref->{$_}, %subopts); + }; + $delim_l = ($opts{delimiters} ? '{' : '').$nlindent2; + $delim_r = $nlindent1.($opts{delimiters} ? '}' : ''); + $separator = ",$nlindent2"; + @items = sort keys %$ref; + } + } elsif (ref($ref) eq "SCALAR") { + $product = defined $$ref ? quotify1 $$ref : "undef"; + } else { + $product = defined $ref ? quotify1 $ref : "undef"; + } + + if (ref($product) eq "CODE") { + $delim_l . join($separator, map { &$product } @items) . $delim_r; + } else { + $product; + } +} + +=back + +=cut + 1; |