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 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 default man section number 57to be used with the given .pod file. This number can be altered if 58the .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 64If 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 75items: 76 77=over 78 79=item B<section =E<gt> N> 80 81The man section number this .pod file belongs to. Often the same as 82was given as input. 83 84=item B<names =E<gt> [ "name", ... ]> 85 86All the names extracted from the NAME section. 87 88=back 89 90=back 91 92=cut 93 94sub 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 1581; 159