From: Richard Levitte Date: Thu, 2 Jun 2016 13:38:16 +0000 (+0200) Subject: perl: refactor .pod name section extractor into its own module X-Git-Tag: OpenSSL_1_1_0-pre6~596 X-Git-Url: https://git.openssl.org/gitweb/?p=openssl.git;a=commitdiff_plain;h=ee2c1a253d558dc64a9d4d5b09dc083a4cff395a;ds=sidebyside perl: refactor .pod name section extractor into its own module Adapt util/process_docs.pl Reviewed-by: Rich Salz --- diff --git a/util/perl/OpenSSL/Util/Pod.pm b/util/perl/OpenSSL/Util/Pod.pm new file mode 100644 index 0000000000..5c0af95918 --- /dev/null +++ b/util/perl/OpenSSL/Util/Pod.pm @@ -0,0 +1,158 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (the "License"). You may not use +# this file except in compliance with the License. You can obtain a copy +# in the file LICENSE in the source distribution or at +# https://www.openssl.org/source/license.html + +package OpenSSL::Util::Pod; + +use strict; +use warnings; + +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +$VERSION = "0.1"; +@ISA = qw(Exporter); +@EXPORT = qw(extract_pod_info); +@EXPORT_OK = qw(); + +=head1 NAME + +OpenSSL::Util::Pod - utilities to manipulate .pod files + +=head1 SYNOPSIS + + use OpenSSL::Util::Pod; + + my %podinfo = extract_pod_info("foo.pod"); + + # or if the file is already opened... Note that this consumes the + # remainder of the file. + + my %podinfo = extract_pod_info(\*STDIN); + +=head1 DESCRIPTION + +=over + +=item B + +=item B + +=item B + +=item B + +Extracts information from a .pod file, given a STRING (file name) or a +GLOB (a file handle). The result is given back as a hash table. + +The additional hash is for extra parameters: + +=over + +=item B
N> + +The value MUST be a number, and will be the default man section number +to be used with the given .pod file. This number can be altered if +the .pod file has a line like this: + + =for comment openssl_manual_section: 4 + +=item B 0|1> + +If set to 1, extra debug text will be printed on STDERR + +=back + +=back + +=head1 RETURN VALUES + +=over + +=item B returns a hash table with the following +items: + +=over + +=item B
N> + +The man section number this .pod file belongs to. Often the same as +was given as input. + +=item B [ "name", ... ]> + +All the names extracted from the NAME section. + +=back + +=back + +=cut + +sub extract_pod_info { + my $input = shift; + my $defaults_ref = shift || {}; + my %defaults = ( debug => 0, section => 0, %$defaults_ref ); + my $fh = undef; + my $filename = undef; + + # If not a file handle, then it's assume to be a file path (a string) + unless (ref $input eq "GLOB") { + $filename = $input; + open $fh, $input or die "Trying to read $filename: $!\n"; + print STDERR "DEBUG: Reading $input\n" if $defaults{debug}; + $input = $fh; + } + + my %podinfo = ( section => $defaults{section}); + while(<$input>) { + s|\R$||; + if (m|^=for\s+comment\s+openssl_manual_section:\s*([0-9])\s*$|) { + print STDERR "DEBUG: Found man section number $1\n" + if $defaults{debug}; + $podinfo{section} = $1; + } + + # Stop reading when we have reached past the NAME section. + last if (m|^=head1| + && defined $podinfo{lastsect} + && $podinfo{lastsect} eq "NAME"); + + # Collect the section name + if (m|^=head1\s*(.*)|) { + $podinfo{lastsect} = $1; + $podinfo{lastsect} =~ s/\s+$//; + print STDERR "DEBUG: Found new pod section $1\n" + if $defaults{debug}; + print STDERR "DEBUG: Clearing pod section text\n" + if $defaults{debug}; + $podinfo{lastsecttext} = ""; + } + + next if (m|^=| || m|^\s*$|); + + # Collect the section text + print STDERR "DEBUG: accumulating pod section text \"$_\"\n" + if $defaults{debug}; + $podinfo{lastsecttext} .= " " if $podinfo{lastsecttext}; + $podinfo{lastsecttext} .= $_; + } + + + if (defined $fh) { + close $fh; + print STDERR "DEBUG: Done reading $filename\n" if $defaults{debug}; + } + + $podinfo{lastsecttext} =~ s| - .*$||; + + my @names = + map { s|\s+||g; $_ } + split(m|,|, $podinfo{lastsecttext}); + + return ( section => $podinfo{section}, names => [ @names ] ); +} + +1; diff --git a/util/process_docs.pl b/util/process_docs.pl index fe8589b18a..8b8de81acd 100644 --- a/util/process_docs.pl +++ b/util/process_docs.pl @@ -20,6 +20,11 @@ use Pod::Usage; use lib '.'; use configdata; +# We know we are in the 'util' directory and that our perl modules are +# in util/perl +use lib catdir(dirname($0), "perl"); +use OpenSSL::Util::Pod; + my %options = (); GetOptions(\%options, 'sourcedir=s', # Source directory @@ -78,44 +83,10 @@ foreach my $subdir (keys %{$options{subdir}}) { foreach my $podfile (glob $podglob) { my $podname = basename($podfile, ".pod"); my $podpath = catfile($podfile); - my %podinfo = ( section => $section ); - - print STDERR "DEBUG: Reading $podpath\n" if $options{debug}; - open my $pod_fh, $podpath or die "Trying to read $podpath: $!\n"; - while (<$pod_fh>) { - s|\R$||; - if (m|^=for\s+comment\s+openssl_manual_section:\s*([0-9])\s*$|) { - print STDERR "DEBUG: Found man section number $1\n" - if $options{debug}; - $podinfo{section} = $1; - } - last if (m|^=head1| - && defined $podinfo{lastsect} - && $podinfo{lastsect} eq "NAME"); - if (m|^=head1\s*(.*)|) { - $podinfo{lastsect} = $1; - $podinfo{lastsect} =~ s/\s+$//; - print STDERR "DEBUG: Found new pod section $1\n" - if $options{debug}; - print STDERR "DEBUG: Clearing pod section text\n" - if $options{debug}; - $podinfo{lastsecttext} = ""; - } - next if (m|^=| || m|^\s*$|); - print STDERR "DEBUG: accumulating pod section text \"$_\"\n" - if $options{debug}; - $podinfo{lastsecttext} .= " " if $podinfo{lastsecttext}; - $podinfo{lastsecttext} .= $_; - } - close $pod_fh; - print STDERR "DEBUG: Done reading $podpath\n" if $options{debug}; - $podinfo{lastsecttext} =~ s| - .*$||; - print STDERR "DEBUG: Done reading $podpath\n" if $options{debug}; - - my @podfiles = - grep { $_ ne $podname } - map { s|\s+||g; $_ } - split(m|,|, $podinfo{lastsecttext}); + my %podinfo = extract_pod_info($podpath, + { debug => $options{debug}, + section => $section }); + my @podfiles = grep { $_ ne $podname } @{$podinfo{names}}; my $updir = updir(); my $name = uc $podname;