[openssl-commits] [openssl] master update
Richard Levitte
levitte at openssl.org
Thu Jun 2 14:02:56 UTC 2016
The branch master has been updated
via ee2c1a253d558dc64a9d4d5b09dc083a4cff395a (commit)
from 8d054a5530defa35ad9a337c23968f8bdef9a6c7 (commit)
- Log -----------------------------------------------------------------
commit ee2c1a253d558dc64a9d4d5b09dc083a4cff395a
Author: Richard Levitte <levitte at openssl.org>
Date: Thu Jun 2 15:38:16 2016 +0200
perl: refactor .pod name section extractor into its own module
Adapt util/process_docs.pl
Reviewed-by: Rich Salz <rsalz at openssl.org>
-----------------------------------------------------------------------
Summary of changes:
util/perl/OpenSSL/Util/Pod.pm | 158 ++++++++++++++++++++++++++++++++++++++++++
util/process_docs.pl | 47 +++----------
2 files changed, 167 insertions(+), 38 deletions(-)
create mode 100644 util/perl/OpenSSL/Util/Pod.pm
diff --git a/util/perl/OpenSSL/Util/Pod.pm b/util/perl/OpenSSL/Util/Pod.pm
new file mode 100644
index 0000000..5c0af95
--- /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";
+ at ISA = qw(Exporter);
+ at EXPORT = qw(extract_pod_info);
+ at 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<extract_pod_info "FILENAME", HASHREF>
+
+=item B<extract_pod_info "FILENAME">
+
+=item B<extract_pod_info GLOB, HASHREF>
+
+=item B<extract_pod_info GLOB>
+
+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<section =E<gt> 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<debug =E<gt> 0|1>
+
+If set to 1, extra debug text will be printed on STDERR
+
+=back
+
+=back
+
+=head1 RETURN VALUES
+
+=over
+
+=item B<extract_pod_info> returns a hash table with the following
+items:
+
+=over
+
+=item B<section =E<gt> N>
+
+The man section number this .pod file belongs to. Often the same as
+was given as input.
+
+=item B<names =E<gt> [ "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 fe8589b..8b8de81 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;
More information about the openssl-commits
mailing list