util/perl/OpenSSL/Util/Pod.pm

   1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
   2 #
   3 # Licensed under the OpenSSL license (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 default man section number
  57 to be used with the given .pod file.  This number can be altered if
  58 the .pod file has a line like this:
  59
  60   =for comment openssl_manual_section: 4
  61
  62 =item B<debug =E<gt> 0|1>
  63
  64 If set to 1, extra debug text will be printed on STDERR
  65
  66 =back
  67
  68 =back
  69
  70 =head1 RETURN VALUES
  71
  72 =over
  73
  74 =item B<extract_pod_info> returns a hash table with the following
  75 items:
  76
  77 =over
  78
  79 =item B<section =E<gt> N>
  80
  81 The man section number this .pod file belongs to.  Often the same as
  82 was given as input.
  83
  84 =item B<names =E<gt> [ "name", ... ]>
  85
  86 All the names extracted from the NAME section.
  87
  88 =back
  89
  90 =back
  91
  92 =cut
  93
  94 sub extract_pod_info {
  95     my $input = shift;
  96     my $defaults_ref = shift || {};
  97     my %defaults = ( debug => 0, section => 0, %$defaults_ref );
  98     my $fh = undef;
  99     my $filename = undef;
 100
 101     # If not a file handle, then it's assume to be a file path (a string)
 102     unless (ref $input eq "GLOB") {
 103         $filename = $input;
 104         open $fh, $input or die "Trying to read $filename: $!\n";
 105         print STDERR "DEBUG: Reading $input\n" if $defaults{debug};
 106         $input = $fh;
 107     }
 108
 109     my %podinfo = ( section => $defaults{section});
 110     while(<$input>) {
 111         s|\R$||;
 112         if (m|^=for\s+comment\s+openssl_manual_section:\s*([0-9])\s*$|) {
 113             print STDERR "DEBUG: Found man section number $1\n"
 114                 if $defaults{debug};
 115             $podinfo{section} = $1;
 116         }
 117
 118         # Stop reading when we have reached past the NAME section.
 119         last if (m|^=head1|
 120                  && defined $podinfo{lastsect}
 121                  && $podinfo{lastsect} eq "NAME");
 122
 123         # Collect the section name
 124         if (m|^=head1\s*(.*)|) {
 125             $podinfo{lastsect} = $1;
 126             $podinfo{lastsect} =~ s/\s+$//;
 127             print STDERR "DEBUG: Found new pod section $1\n"
 128                 if $defaults{debug};
 129             print STDERR "DEBUG: Clearing pod section text\n"
 130                 if $defaults{debug};
 131             $podinfo{lastsecttext} = "";
 132         }
 133
 134         next if (m|^=| || m|^\s*$|);
 135
 136         # Collect the section text
 137         print STDERR "DEBUG: accumulating pod section text \"$_\"\n"
 138             if $defaults{debug};
 139         $podinfo{lastsecttext} .= " " if $podinfo{lastsecttext};
 140         $podinfo{lastsecttext} .= $_;
 141     }
 142
 143
 144     if (defined $fh) {
 145         close $fh;
 146         print STDERR "DEBUG: Done reading $filename\n" if $defaults{debug};
 147     }
 148
 149     $podinfo{lastsecttext} =~ s| - .*$||;
 150
 151     my @names =
 152         map { s|\s+||g; $_ }
 153         split(m|,|, $podinfo{lastsecttext});
 154
 155     return ( section => $podinfo{section}, names => [ @names ] );
 156 }
 157
 158 1;