util/perl/OpenSSL/Util/Pod.pm

   1 # Copyright 2016-2020 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 =item B<contents =E<gt> "...">
  86
  87 The whole contents of the .pod file.
  88
  89 =back
  90
  91 =back
  92
  93 =cut
  94
  95 sub 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
 193 1;