xref: /openssl/util/perl/OpenSSL/Util/Pod.pm (revision 4333b89f) 
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