1# Copyright 2016-2021 The OpenSSL Project Authors. All Rights Reserved. 2# 3# Licensed under the Apache License 2.0 (the "License"). You may not use 4# this file except in compliance with the License. You can obtain a copy 5# in the file LICENSE in the source distribution or at 6# https://www.openssl.org/source/license.html 7 8package OpenSSL::Util::Pod; 9 10use strict; 11use warnings; 12 13use Exporter; 14use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 15$VERSION = "0.1"; 16@ISA = qw(Exporter); 17@EXPORT = qw(extract_pod_info); 18@EXPORT_OK = qw(); 19 20=head1 NAME 21 22OpenSSL::Util::Pod - utilities to manipulate .pod files 23 24=head1 SYNOPSIS 25 26 use OpenSSL::Util::Pod; 27 28 my %podinfo = extract_pod_info("foo.pod"); 29 30 # or if the file is already opened... Note that this consumes the 31 # remainder of the file. 32 33 my %podinfo = extract_pod_info(\*STDIN); 34 35=head1 DESCRIPTION 36 37=over 38 39=item B<extract_pod_info "FILENAME", HASHREF> 40 41=item B<extract_pod_info "FILENAME"> 42 43=item B<extract_pod_info GLOB, HASHREF> 44 45=item B<extract_pod_info GLOB> 46 47Extracts information from a .pod file, given a STRING (file name) or a 48GLOB (a file handle). The result is given back as a hash table. 49 50The additional hash is for extra parameters: 51 52=over 53 54=item B<section =E<gt> N> 55 56The value MUST be a number, and will be the man section number 57to be used with the given .pod file. 58 59=item B<debug =E<gt> 0|1> 60 61If set to 1, extra debug text will be printed on STDERR 62 63=back 64 65=back 66 67=head1 RETURN VALUES 68 69=over 70 71=item B<extract_pod_info> returns a hash table with the following 72items: 73 74=over 75 76=item B<section =E<gt> N> 77 78The man section number this .pod file belongs to. Often the same as 79was given as input. 80 81=item B<names =E<gt> [ "name", ... ]> 82 83All the names extracted from the NAME section. 84 85=item B<contents =E<gt> "..."> 86 87The whole contents of the .pod file. 88 89=back 90 91=back 92 93=cut 94 95sub extract_pod_info { 96 my $input = shift; 97 my $defaults_ref = shift || {}; 98 my %defaults = ( debug => 0, section => 0, %$defaults_ref ); 99 my $fh = undef; 100 my $filename = undef; 101 my $contents; 102 103 # If not a file handle, then it's assume to be a file path (a string) 104 if (ref $input eq "") { 105 $filename = $input; 106 open $fh, $input or die "Trying to read $filename: $!\n"; 107 print STDERR "DEBUG: Reading $input\n" if $defaults{debug}; 108 $input = $fh; 109 } 110 if (ref $input eq "GLOB") { 111 local $/ = undef; 112 $contents = <$input>; 113 } else { 114 die "Unknown input type"; 115 } 116 117 my @invisible_names = (); 118 my %podinfo = ( section => $defaults{section}); 119 $podinfo{lastsecttext} = ""; # init needed in case input file is empty 120 121 # Regexp to split a text into paragraphs found at 122 # https://www.perlmonks.org/?node_id=584367 123 # Most of all, \G (continue at last match end) and /g (anchor 124 # this match for \G) are significant 125 foreach (map { /\G((?:(?!\n\n).)*\n+|.+\z)/sg } $contents) { 126 # Remove as many line endings as possible from the end of the paragraph 127 while (s|\R$||) {} 128 129 print STDERR "DEBUG: Paragraph:\n$_\n" 130 if $defaults{debug}; 131 132 # Stop reading when we have reached past the NAME section. 133 last if (m|^=head1| 134 && defined $podinfo{lastsect} 135 && $podinfo{lastsect} eq "NAME"); 136 137 # Collect the section name 138 if (m|^=head1\s*(.*)|) { 139 $podinfo{lastsect} = $1; 140 $podinfo{lastsect} =~ s/\s+$//; 141 print STDERR "DEBUG: Found new pod section $1\n" 142 if $defaults{debug}; 143 print STDERR "DEBUG: Clearing pod section text\n" 144 if $defaults{debug}; 145 $podinfo{lastsecttext} = ""; 146 } 147 148 # Add invisible names 149 if (m|^=for\s+openssl\s+names:\s*(.*)|s) { 150 my $x = $1; 151 my @tmp = map { map { s/\s+//g; $_ } split(/,/, $_) } $x; 152 print STDERR 153 "DEBUG: Found invisible names: ", join(', ', @tmp), "\n" 154 if $defaults{debug}; 155 push @invisible_names, @tmp; 156 } 157 158 next if (m|^=| || m|^\s*$|); 159 160 # Collect the section text 161 print STDERR "DEBUG: accumulating pod section text \"$_\"\n" 162 if $defaults{debug}; 163 $podinfo{lastsecttext} .= " " if $podinfo{lastsecttext}; 164 $podinfo{lastsecttext} .= $_; 165 } 166 167 168 if (defined $fh) { 169 close $fh; 170 print STDERR "DEBUG: Done reading $filename\n" if $defaults{debug}; 171 } 172 173 $podinfo{lastsecttext} =~ s|\s+-\s+.*$||s; 174 175 my @names = 176 map { s/^\s+//g; # Trim prefix blanks 177 s/\s+$//g; # Trim suffix blanks 178 s|/|-|g; # Treat slash as dash 179 $_ } 180 split(m|,|, $podinfo{lastsecttext}); 181 182 print STDERR 183 "DEBUG: Collected names are: ", 184 join(', ', @names, @invisible_names), "\n" 185 if $defaults{debug}; 186 187 return ( section => $podinfo{section}, 188 names => [ @names, @invisible_names ], 189 contents => $contents, 190 filename => $filename ); 191} 192 1931; 194