Home | History | Annotate | Line # | Download | only in Util 
      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 
      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;
    194