#!/usr/bin/perl -- ## ## ## ## ## perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END if while for " -otr -opr -ce -nibc -i=4 -pt=0 "-nsak=*" ## ## use warnings; use strict; use Pod::Html; use Pod::Simple::XHTML; my @releases = ( 'master', '1.0.2', '1.0.1', '1.0.0', '0.9.8' ); my %relmap = map { $_ => 1 } @releases; my @sections = ( 'apps', 'crypto', 'ssl' ); ## this part just testing genhtml ## also a look at one way of maybe improving gennames ... turns out its almost equally low level approach, meh :) my $filename = 'openssl-1.0.1p/doc/crypto/BN_add_word.pod'; use Pod::Simple::SimpleTree; use Data::Dumper; my $pst = Pod::Simple::SimpleTree->new; $pst->parse_file( $filename ); print Dumper( $pst->root ); use Path::Tiny; path( 'fudge.html' )->spew( genhtml( '$RELEASE', '$sect', $filename, '$title', '$basename' ) ); exit; Main( @ARGV ); exit( 0 ); sub Main { #~ die "Mssing args\n" if $#ARGV < 2; die "Mssing args\n" if @_ < 2; # Verify source dir. my $SRCDIR = shift || die "Source dir missing"; die "No source directory $SRCDIR" unless -d $SRCDIR; foreach my $sect ( @sections ) { my $dir = "$SRCDIR/doc/$sect"; die "No directory $dir" unless -d $dir; } # Verify release. my $RELEASE = shift || die "RELEASE missing"; die "Unknown release $RELEASE" unless defined $relmap{$RELEASE}; # Cleanup and verify the destination. my $WWWDIR = shift || die "Destination missing"; die "No destination directory $WWWDIR" unless -d $WWWDIR; cleanup( $WWWDIR, $RELEASE ); foreach my $sect ( @sections ) { foreach my $filename ( glob( "$SRCDIR/doc/$sect/*.pod" ) ) { my $basename = $filename; $basename =~ s@.*/@@; $basename =~ s@.pod@@; my $title = $basename; my $out = genhtml( $RELEASE, $sect, $filename, $title, $basename ); my $outfile = "$WWWDIR/man$RELEASE/$sect/$basename.html"; open( my $fh, ">", $outfile ) || die "Can't open $outfile, $!"; print $fh $out || die "Can't print $outfile, $!"; close( $fh ) || die "Can't close $outfile, $!"; my @altnames = getnames( $filename, $basename ); foreach my $alt ( @altnames ) { my $target = "$WWWDIR/man$RELEASE/$sect/$alt.html"; link $outfile, $target || die "Can't link $outfile,$target, $!"; } } } } ## end sub Main # Remove all files from a manpage subtree, and leave only # the index and the section subdirs. sub cleanup { ## sub cleanNotIndexNotDir my( $wwwdir, $release ) = @_; my $dir = "$wwwdir/man$release"; die "No $dir/index.html" unless -f "$dir/index.html"; foreach my $sect ( @sections ) { mkdir "$dir/$sect" unless -d "$dir/$sect"; foreach my $f ( glob( "$dir/$sect/*" ) ) { unlink $f || warn "Can't unlink $f, $!"; } } } ## end sub cleanup sub genhtml { ## sub man2html my( $release, $section, $filename, $title, $file ) = @_; my $header = <
$sidebar
EOFT open( my $fh, $filename ) || die "Can't open $filename, $!"; my $infile = do { local $/; <$fh>; }; ## just for kicks #~ # L ==> L #~ $infile =~ s/L<[^|>]*\|([^>]+)>/L<$1>/g; #~ # L --> L #~ $infile =~ s/L<([^>]+)\(\d\)>/L<$1>/g; #~ my $out; my $pod = MyPSX->new; $pod->html_h_level( 3 ); # $pod->index(1); $pod->perldoc_url_prefix( "https://www.openssl.org/docs/man$release/$section/" ); $pod->perldoc_url_postfix( ".html" ); $pod->man_url_prefix( "https://www.openssl.org/docs/man$release/$section/" ); $pod->man_url_postfix( ".html" ); $pod->html_header( $header ); $pod->html_footer( $footer ); # $pod->force_title("TILETITLETITLE"); # $pod->backlink(1); $pod->output_string( \$out ); $pod->parse_string_document( $infile ); return $out; } ## end sub genhtml sub getnames { ## sub man2names ## sub namesFromMan my( $infile, $basename ) = @_; my @words = (); open( my $fh, "<", $infile ) || die "Can't open $infile, $!"; { local $/ = ""; my $found = 0; while( <$fh> ) { chop; s/\n/ /gm; if( /^=head1 / ) { $found = 0; } elsif( $found ) { if( / - / ) { s/ - .*//; s/,\s+/,/g; s/\s+,/,/g; s/^\s+//g; s/\s+$//g; s/\s/_/g; push @words, split ','; } } if( /^=head1\s*NAME\s*$/ ) { $found = 1; } } ## end while( <$fh> ) } return grep { $_ ne $basename } @words; } ## end sub getnames BEGIN { package MyPSX; use Pod::Simple::XHTML; use parent qw[ Pod::Simple::XHTML ]; sub resolve_man_page_link { my( $self, $to, $section ) = @_; return undef unless defined $to; my( $page, $part ) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/; return undef unless $page; warn " $page, $part "; return ( $self->man_url_prefix || '' ) #~ . ( $part || 1 ) . "/" . $self->encode_entities( $page ) . ( $self->man_url_postfix || '' ); } ## end sub resolve_man_page_link } ## end BEGIN __END__