02ad0a8f39b2604987b44bc383b10c637774c8ab
[openssl.git] / util / perl / OpenSSL / Util / Pod.pm
1 # Copyright 2016 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
8 package OpenSSL::Util::Pod;
9
10 use strict;
11 use warnings;
12
13 use Exporter;
14 use 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
22 OpenSSL::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
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.
49
50 The additional hash is for extra parameters:
51
52 =over
53
54 =item B<section =E<gt> N>
55
56 The value MUST be a number, and will be the man section number
57 to be used with the given .pod file.
58
59 =item B<debug =E<gt> 0|1>
60
61 If 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
72 items:
73
74 =over
75
76 =item B<section =E<gt> N>
77
78 The man section number this .pod file belongs to.  Often the same as
79 was given as input.
80
81 =item B<names =E<gt> [ "name", ... ]>
82
83 All the names extracted from the NAME section.
84
85 =back
86
87 =back
88
89 =cut
90
91 sub extract_pod_info {
92     my $input = shift;
93     my $defaults_ref = shift || {};
94     my %defaults = ( debug => 0, section => 0, %$defaults_ref );
95     my $fh = undef;
96     my $filename = undef;
97
98     # If not a file handle, then it's assume to be a file path (a string)
99     unless (ref $input eq "GLOB") {
100         $filename = $input;
101         open $fh, $input or die "Trying to read $filename: $!\n";
102         print STDERR "DEBUG: Reading $input\n" if $defaults{debug};
103         $input = $fh;
104     }
105
106     my %podinfo = ( section => $defaults{section});
107     while(<$input>) {
108         s|\R$||;
109         # Stop reading when we have reached past the NAME section.
110         last if (m|^=head1|
111                  && defined $podinfo{lastsect}
112                  && $podinfo{lastsect} eq "NAME");
113
114         # Collect the section name
115         if (m|^=head1\s*(.*)|) {
116             $podinfo{lastsect} = $1;
117             $podinfo{lastsect} =~ s/\s+$//;
118             print STDERR "DEBUG: Found new pod section $1\n"
119                 if $defaults{debug};
120             print STDERR "DEBUG: Clearing pod section text\n"
121                 if $defaults{debug};
122             $podinfo{lastsecttext} = "";
123         }
124
125         next if (m|^=| || m|^\s*$|);
126
127         # Collect the section text
128         print STDERR "DEBUG: accumulating pod section text \"$_\"\n"
129             if $defaults{debug};
130         $podinfo{lastsecttext} .= " " if $podinfo{lastsecttext};
131         $podinfo{lastsecttext} .= $_;
132     }
133
134
135     if (defined $fh) {
136         close $fh;
137         print STDERR "DEBUG: Done reading $filename\n" if $defaults{debug};
138     }
139
140     $podinfo{lastsecttext} =~ s| - .*$||;
141
142     my @names =
143         map { s|\s+||g; $_ }
144         split(m|,|, $podinfo{lastsecttext});
145
146     return ( section => $podinfo{section}, names => [ @names ] );
147 }
148
149 1;