From 23d221b771348e3e3ee316cd1190a4a344d145fc Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Sun, 16 Dec 2018 00:47:18 +0100 Subject: [PATCH 1/1] util/process_docs.pl: handle multiple source directories correctly The way this script handled multiple source directories wasn't quite right, it ended up giving pod2html 'ARRAY(0xXXXXXXXXX)' as a source directory. This corrects the mistake. Fixes #7742 Fixes #7939 Reviewed-by: Tim Hudson (Merged from https://github.com/openssl/openssl/pull/7911) --- util/process_docs.pl | 195 ++++++++++++++++++++++--------------------- 1 file changed, 102 insertions(+), 93 deletions(-) diff --git a/util/process_docs.pl b/util/process_docs.pl index d2fef5dedf..a4287c27d7 100755 --- a/util/process_docs.pl +++ b/util/process_docs.pl @@ -84,114 +84,123 @@ my $symlink_exists = eval { symlink("",""); 1 }; foreach my $section (sort @{$options{section}}) { my $subdir = "man$section"; - my @podsourcedirs = map { catfile($_, $subdir); } @{$options{sourcedir}}; - my @podglobs = map { catfile($_, "*.pod"); } @podsourcedirs; - - foreach my $podfile (map { glob $_ } @podglobs) { - my $podname = basename($podfile, ".pod"); - my $podpath = catfile($podfile); - 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; - my $suffix = { man => ".$podinfo{section}".($options{suffix} // ""), - html => ".html" } -> {$options{type}}; - my $generate = { man => "pod2man --name=$name --section=$podinfo{section} --center=OpenSSL --release=$config{version} \"$podpath\"", - html => "pod2html \"--podroot=$options{sourcedir}\" --htmldir=$updir --podpath=man1:man3:man5:man7 \"--infile=$podpath\" \"--title=$podname\" --quiet" - } -> {$options{type}}; - my $output_dir = catdir($options{destdir}, "man$podinfo{section}"); - my $output_file = $podname . $suffix; - my $output_path = catfile($output_dir, $output_file); - - if (! $options{remove}) { - my @output; - print STDERR "DEBUG: Processing, using \"$generate\"\n" - if $options{debug}; - unless ($options{"dry-run"}) { - @output = `$generate`; - map { s|href="http://man\.he\.net/(man\d/[^"]+)(?:\.html)?"|href="../$1.html"|g; } @output - if $options{type} eq "html"; - if ($options{type} eq "man") { - # Because some *roff parsers are more strict than others, - # multiple lines in the NAME section must be merged into - # one. - my $in_name = 0; - my $name_line = ""; - my @newoutput = (); - foreach (@output) { - if ($in_name) { - if (/^\.SH "/) { - $in_name = 0; - push @newoutput, $name_line."\n"; - } else { - chomp (my $x = $_); - $name_line .= " " if $name_line; - $name_line .= $x; - next; + foreach my $sourcedir (@{$options{sourcedir}}) { + my $podsourcedir = catfile($sourcedir, $subdir); + my $podglob = catfile($podsourcedir, "*.pod"); + + foreach my $podfile (glob $podglob) { + my $podname = basename($podfile, ".pod"); + my $podpath = catfile($podfile); + 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; + my $suffix = + { man => ".$podinfo{section}".($options{suffix} // ""), + html => ".html" } -> {$options{type}}; + my $generate = + { man => <<"_____", +pod2man --name=$name --section=$podinfo{section} --center=OpenSSL --release=$config{version} "$podpath" +_____ + html => <<"_____", +pod2html "--podroot=$sourcedir" --htmldir=$updir --podpath=man1:man3:man5:man7 "--infile=$podpath" "--title=$podname" --quiet +_____ + } -> {$options{type}}; + my $output_dir = catdir($options{destdir}, "man$podinfo{section}"); + my $output_file = $podname . $suffix; + my $output_path = catfile($output_dir, $output_file); + + if (! $options{remove}) { + my @output; + print STDERR "DEBUG: Processing, using \"$generate\"\n" + if $options{debug}; + unless ($options{"dry-run"}) { + @output = `$generate`; + map { s|href="http://man\.he\.net/(man\d/[^"]+)(?:\.html)?"|href="../$1.html"|g; } @output + if $options{type} eq "html"; + if ($options{type} eq "man") { + # Because some *roff parsers are more strict than + # others, multiple lines in the NAME section must + # be merged into one. + my $in_name = 0; + my $name_line = ""; + my @newoutput = (); + foreach (@output) { + if ($in_name) { + if (/^\.SH "/) { + $in_name = 0; + push @newoutput, $name_line."\n"; + } else { + chomp (my $x = $_); + $name_line .= " " if $name_line; + $name_line .= $x; + next; + } } + if (/^\.SH +"NAME" *$/) { + $in_name = 1; + } + push @newoutput, $_; } - if (/^\.SH +"NAME" *$/) { - $in_name = 1; - } - push @newoutput, $_; + @output = @newoutput; } - @output = @newoutput; } - } - print STDERR "DEBUG: Done processing\n" if $options{debug}; + print STDERR "DEBUG: Done processing\n" if $options{debug}; - if (! -d $output_dir) { - print STDERR "DEBUG: Creating directory $output_dir\n" if $options{debug}; + if (! -d $output_dir) { + print STDERR "DEBUG: Creating directory $output_dir\n" + if $options{debug}; + unless ($options{"dry-run"}) { + mkpath $output_dir + or die "Trying to create directory $output_dir: $!\n"; + } + } + print STDERR "DEBUG: Writing $output_path\n" if $options{debug}; unless ($options{"dry-run"}) { - mkpath $output_dir - or die "Trying to create directory $output_dir: $!\n"; + open my $output_fh, '>', $output_path + or die "Trying to write to $output_path: $!\n"; + foreach (@output) { + print $output_fh $_; + } + close $output_fh; } - } - print STDERR "DEBUG: Writing $output_path\n" if $options{debug}; - unless ($options{"dry-run"}) { - open my $output_fh, '>', $output_path - or die "Trying to write to $output_path: $!\n"; - foreach (@output) { - print $output_fh $_; + print STDERR "DEBUG: Done writing $output_path\n" if $options{debug}; + } else { + print STDERR "DEBUG: Removing $output_path\n" if $options{debug}; + unless ($options{"dry-run"}) { + while (unlink $output_path) {} } - close $output_fh; } - print STDERR "DEBUG: Done writing $output_path\n" if $options{debug}; - } else { - print STDERR "DEBUG: Removing $output_path\n" if $options{debug}; - unless ($options{"dry-run"}) { - while (unlink $output_path) {} - } - } - print "$output_path\n"; - - foreach (@podfiles) { - my $link_file = $_ . $suffix; - my $link_path = catfile($output_dir, $link_file); - if (! $options{remove}) { - if ($symlink_exists) { - print STDERR "DEBUG: Linking $link_path -> $output_file\n" - if $options{debug}; - unless ($options{"dry-run"}) { - symlink $output_file, $link_path; + print "$output_path\n"; + + foreach (@podfiles) { + my $link_file = $_ . $suffix; + my $link_path = catfile($output_dir, $link_file); + if (! $options{remove}) { + if ($symlink_exists) { + print STDERR "DEBUG: Linking $link_path -> $output_file\n" + if $options{debug}; + unless ($options{"dry-run"}) { + symlink $output_file, $link_path; + } + } else { + print STDERR "DEBUG: Copying $output_path to link_path\n" + if $options{debug}; + unless ($options{"dry-run"}) { + copy $output_path, $link_path; + } } } else { - print STDERR "DEBUG: Copying $output_path to link_path\n" - if $options{debug}; + print STDERR "DEBUG: Removing $link_path\n" if $options{debug}; unless ($options{"dry-run"}) { - copy $output_path, $link_path; + while (unlink $link_path) {} } } - } else { - print STDERR "DEBUG: Removing $link_path\n" if $options{debug}; - unless ($options{"dry-run"}) { - while (unlink $link_path) {} - } + print "$link_path -> $output_path\n"; } - print "$link_path -> $output_path\n"; } } } -- 2.34.1