]>
git.ipfire.org Git - thirdparty/openssl.git/blob - util/perl/OpenSSL/Util/Pod.pm
b71f3901e084c56a5946504a79071642baa49d23
1 # Copyright 2016-2020 The OpenSSL Project Authors. All Rights Reserved.
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
8 package OpenSSL
::Util
::Pod
;
14 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
17 @EXPORT = qw(extract_pod_info);
22 OpenSSL::Util::Pod - utilities to manipulate .pod files
26 use OpenSSL::Util::Pod;
28 my %podinfo = extract_pod_info("foo.pod");
30 # or if the file is already opened... Note that this consumes the
31 # remainder of the file.
33 my %podinfo = extract_pod_info(\*STDIN);
39 =item B<extract_pod_info "FILENAME", HASHREF>
41 =item B<extract_pod_info "FILENAME">
43 =item B<extract_pod_info GLOB, HASHREF>
45 =item B<extract_pod_info GLOB>
47 Extracts information from a .pod file, given a STRING (file name) or a
48 GLOB (a file handle). The result is given back as a hash table.
50 The additional hash is for extra parameters:
54 =item B<section =E<gt> N>
56 The value MUST be a number, and will be the man section number
57 to be used with the given .pod file.
59 =item B<debug =E<gt> 0|1>
61 If set to 1, extra debug text will be printed on STDERR
71 =item B<extract_pod_info> returns a hash table with the following
76 =item B<section =E<gt> N>
78 The man section number this .pod file belongs to. Often the same as
81 =item B<names =E<gt> [ "name", ... ]>
83 All the names extracted from the NAME section.
85 =item B<contents =E<gt> "...">
87 The whole contents of the .pod file.
95 sub extract_pod_info
{
97 my $defaults_ref = shift || {};
98 my %defaults = ( debug
=> 0, section
=> 0, %$defaults_ref );
100 my $filename = undef;
103 # If not a file handle, then it's assume to be a file path (a string)
104 if (ref $input eq "") {
106 open $fh, $input or die "Trying to read $filename: $!\n";
107 print STDERR
"DEBUG: Reading $input\n" if $defaults{debug
};
110 if (ref $input eq "GLOB") {
112 $contents = <$input>;
114 die "Unknown input type";
117 my @invisible_names = ();
118 my %podinfo = ( section
=> $defaults{section
});
119 $podinfo{lastsecttext
} = ""; # init needed in case input file is empty
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
129 print STDERR
"DEBUG: Paragraph:\n$_\n"
132 # Stop reading when we have reached past the NAME section.
134 && defined $podinfo{lastsect
}
135 && $podinfo{lastsect
} eq "NAME");
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"
143 print STDERR
"DEBUG: Clearing pod section text\n"
145 $podinfo{lastsecttext
} = "";
148 # Add invisible names
149 if (m
|^=for\s
+openssl\s
+names
:\s
*(.*)|s
) {
151 my @tmp = map { map { s/\s+//g; $_ } split(/,/, $_) } $x;
153 "DEBUG: Found invisible names: ", join(', ', @tmp), "\n"
155 push @invisible_names, @tmp;
158 next if (m
|^=| || m
|^\s
*$|);
160 # Collect the section text
161 print STDERR
"DEBUG: accumulating pod section text \"$_\"\n"
163 $podinfo{lastsecttext
} .= " " if $podinfo{lastsecttext
};
164 $podinfo{lastsecttext
} .= $_;
170 print STDERR
"DEBUG: Done reading $filename\n" if $defaults{debug
};
173 $podinfo{lastsecttext
} =~ s
|\s
+-\s
+.*$||s
;
176 map { s/^\s+//g; # Trim prefix blanks
177 s/\s+$//g; # Trim suffix blanks
178 s
|/|-|g
; # Treat slash as dash
180 split(m
|,|, $podinfo{lastsecttext
});
183 "DEBUG: Collected names are: ",
184 join(', ', @names, @invisible_names), "\n"
187 return ( section
=> $podinfo{section
},
188 names
=> [ @names, @invisible_names ],
189 contents
=> $contents,
190 filename
=> $filename );