mirror of
				https://github.com/ossrs/srs.git
				synced 2025-03-09 15:49:59 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			271 lines
		
	
	
	
		
			9.4 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable file
		
	
	
	
	
			
		
		
	
	
			271 lines
		
	
	
	
		
			9.4 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable file
		
	
	
	
	
| #! /usr/bin/env perl
 | |
| # Copyright 2016-2018 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
 | |
| 
 | |
| use strict;
 | |
| use warnings;
 | |
| 
 | |
| use File::Spec::Functions;
 | |
| use File::Basename;
 | |
| use File::Copy;
 | |
| use File::Path;
 | |
| use FindBin;
 | |
| use lib "$FindBin::Bin/perl";
 | |
| use OpenSSL::Glob;
 | |
| use Getopt::Long;
 | |
| 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
 | |
|            'section=i@',        # Subdirectories to look through,
 | |
|                                 # with associated section numbers
 | |
|            'destdir=s',         # Destination directory
 | |
|            #'in=s@',             # Explicit files to process (ignores sourcedir)
 | |
|            'type=s',            # The result type, 'man' or 'html'
 | |
|            'suffix:s',          # Suffix to add to the extension.
 | |
|                                 # Only used with type=man
 | |
|            'remove',            # To remove files rather than writing them
 | |
|            'dry-run|n',         # Only output file names on STDOUT
 | |
|            'debug|D+',
 | |
|           );
 | |
| 
 | |
| unless ($options{section}) {
 | |
|     $options{section} = [ 1, 3, 5, 7 ];
 | |
| }
 | |
| unless ($options{sourcedir}) {
 | |
|     $options{sourcedir} = catdir($config{sourcedir}, "doc");
 | |
| }
 | |
| pod2usage(1) unless ( defined $options{section}
 | |
|                       && defined $options{sourcedir}
 | |
|                       && defined $options{destdir}
 | |
|                       && defined $options{type}
 | |
|                       && ($options{type} eq 'man'
 | |
|                           || $options{type} eq 'html') );
 | |
| pod2usage(1) if ( $options{type} eq 'html'
 | |
|                   && defined $options{suffix} );
 | |
| 
 | |
| if ($options{debug}) {
 | |
|     print STDERR "DEBUG: options:\n";
 | |
|     print STDERR "DEBUG:   --sourcedir = $options{sourcedir}\n"
 | |
|         if defined $options{sourcedir};
 | |
|     print STDERR "DEBUG:   --destdir   = $options{destdir}\n"
 | |
|         if defined $options{destdir};
 | |
|     print STDERR "DEBUG:   --type      = $options{type}\n"
 | |
|         if defined $options{type};
 | |
|     print STDERR "DEBUG:   --suffix    = $options{suffix}\n"
 | |
|         if defined $options{suffix};
 | |
|     foreach (sort @{$options{section}}) {
 | |
|         print STDERR "DEBUG:   --section   = $_\n";
 | |
|     }
 | |
|     print STDERR "DEBUG:   --remove    = $options{remove}\n"
 | |
|         if defined $options{remove};
 | |
|     print STDERR "DEBUG:   --debug     = $options{debug}\n"
 | |
|         if defined $options{debug};
 | |
|     print STDERR "DEBUG:   --dry-run   = $options{\"dry-run\"}\n"
 | |
|         if defined $options{"dry-run"};
 | |
| }
 | |
| 
 | |
| my $symlink_exists = eval { symlink("",""); 1 };
 | |
| 
 | |
| foreach my $section (sort @{$options{section}}) {
 | |
|     my $subdir = "man$section";
 | |
|     my $podsourcedir = catfile($options{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=$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;
 | |
|                             }
 | |
|                         }
 | |
|                         if (/^\.SH +"NAME" *$/) {
 | |
|                             $in_name = 1;
 | |
|                         }
 | |
|                         push @newoutput, $_;
 | |
|                     }
 | |
|                     @output = @newoutput;
 | |
|                 }
 | |
|             }
 | |
|             print STDERR "DEBUG: Done processing\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"}) {
 | |
|                 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: 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;
 | |
|                     }
 | |
|                 } 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: Removing $link_path\n" if $options{debug};
 | |
|                 unless ($options{"dry-run"}) {
 | |
|                     while (unlink $link_path) {}
 | |
|                 }
 | |
|             }
 | |
|             print "$link_path -> $output_path\n";
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| __END__
 | |
| 
 | |
| =pod
 | |
| 
 | |
| =head1 NAME
 | |
| 
 | |
| process_docs.pl - A script to process OpenSSL docs
 | |
| 
 | |
| =head1 SYNOPSIS
 | |
| 
 | |
| B<process_docs.pl>
 | |
| [B<--sourcedir>=I<dir>]
 | |
| B<--destdir>=I<dir>
 | |
| B<--type>=B<man>|B<html>
 | |
| [B<--suffix>=I<suffix>]
 | |
| [B<--remove>]
 | |
| [B<--dry-run>|B<-n>]
 | |
| [B<--debug>|B<-D>]
 | |
| 
 | |
| =head1 DESCRIPTION
 | |
| 
 | |
| This script looks for .pod files in the subdirectories 'apps', 'crypto'
 | |
| and 'ssl' under the given source directory.
 | |
| 
 | |
| The OpenSSL configuration data file F<configdata.pm> I<must> reside in
 | |
| the current directory, I<or> perl must have the directory it resides in
 | |
| in its inclusion array.  For the latter variant, a call like this would
 | |
| work:
 | |
| 
 | |
|  perl -I../foo util/process_docs.pl {options ...}
 | |
| 
 | |
| =head1 OPTIONS
 | |
| 
 | |
| =over 4
 | |
| 
 | |
| =item B<--sourcedir>=I<dir>
 | |
| 
 | |
| Top directory where the source files are found.
 | |
| 
 | |
| =item B<--destdir>=I<dir>
 | |
| 
 | |
| Top directory where the resulting files should end up
 | |
| 
 | |
| =item B<--type>=B<man>|B<html>
 | |
| 
 | |
| Type of output to produce.  Currently supported are man pages and HTML files.
 | |
| 
 | |
| =item B<--suffix>=I<suffix>
 | |
| 
 | |
| A suffix added to the extension.  Only valid with B<--type>=B<man>
 | |
| 
 | |
| =item B<--remove>
 | |
| 
 | |
| Instead of writing the files, remove them.
 | |
| 
 | |
| =item B<--dry-run>|B<-n>
 | |
| 
 | |
| Do not perform any file writing, directory creation or file removal.
 | |
| 
 | |
| =item B<--debug>|B<-D>
 | |
| 
 | |
| Print extra debugging output.
 | |
| 
 | |
| =back
 | |
| 
 | |
| =head1 COPYRIGHT
 | |
| 
 | |
| Copyright 2013-2018 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
 | |
| 
 | |
| =cut
 |