diff options
Diffstat (limited to 'devel/man-to-mdwn.pl')
| -rwxr-xr-x | devel/man-to-mdwn.pl | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/devel/man-to-mdwn.pl b/devel/man-to-mdwn.pl new file mode 100755 index 00000000..4b59bd66 --- /dev/null +++ b/devel/man-to-mdwn.pl @@ -0,0 +1,197 @@ +#!/usr/bin/perl +# +# Author: Tomi Ollila +# License: same as notmuch +# +# This program is used to generate mdwn-formatted notmuch manual pages +# for notmuch wiki. Example run: +# +# $ ./devel/man-to-mdwn.pl man ../notmuch-wiki +# +# In case taken into more generic use, modify these comments and examples. + +use 5.8.1; +use strict; +use warnings; + +unless (@ARGV == 2) { + warn "\n$0 <source-directory> <destination-directory>\n\n"; + # Remove/edit this comment if this script is taken into generic use. + warn "Example: ./devel/man-to-mdwn.pl man ../notmuch-wiki\n\n"; + exit 1; +} + +die "'$ARGV[0]': no such source directory\n" unless -d $ARGV[0]; +die "'$ARGV[1]': no such destination directory\n" unless -d $ARGV[1]; + +#die "'manpages' exists\n" if -e 'manpages'; +#die "'manpages.mdwn' exists\n" if -e 'manpages.mdwn'; + +die "Expecting '$ARGV[1]/manpages' to exist.\n" . + "Please create it first or adjust <destination-directory>.\n" + unless -d $ARGV[1] . '/manpages'; + +my $ev = 0; +my %fhash; + +open P, '-|', 'find', $ARGV[0], qw/-name *.[0-9] -print/; +while (<P>) +{ + chomp; + next unless -f $_; # follows symlink. + $ev = 1, warn "'$_': no such file\n" unless -f $_; + my ($in, $on) = ($_, $_); + $on =~ s|.*/||; $on =~ tr/./-/; + my $f = $fhash{$on}; + $ev = 1, warn "'$in' collides with '$f' ($on.mdwn)\n" if defined $f; + $fhash{$on} = $in; +} +close P; + +#undef $ENV{'GROFF_NO_SGR'}; +#delete $ENV{'GROFF_NO_SGR'}; +$ENV{'GROFF_NO_SGR'} = '1'; +$ENV{'TERM'} = 'vt100'; # does this matter ? + +my %htmlqh = qw/& & < < > > ' ' " "/; +# do html quotation to $_[0] (which is an alias to the given arg) +sub htmlquote($) +{ + $_[0] =~ s/([&<>'"])/$htmlqh{$1}/ge; +} + +sub maymakelink($); +sub mayconvert($$); + +#warn keys %fhash, "\n"; + +while (my ($k, $v) = each %fhash) +{ + #next if -l $v; # skip symlinks here. -- not... references there may be. + + my @lines; + #open I, '-|', qw/groff -man -T utf8/, $v; + open I, '-|', qw/groff -man -T latin1/, $v; # this and GROFF_NO_SGR='1' + + my ($emptyline, $pre, $hl) = (0, 0, 'h1'); + while (<I>) { + if (/^\s*$/) { + $emptyline = 1; + next; + } + s/(?<=\S)\s{8,}.*//; # $hl = 'h1' if s/(?<=\S)\s{8,}.*//; + htmlquote $_; + s/[_&]\010&/&/g; + s/((?:_\010[^_])+)/<u>$1<\/u>/g; + s/_\010(.)/$1/g; + s/((?:.\010.)+)/<b>$1<\/b>/g; + s/.\010(.)/$1/g; + + if (/^\S/) { + $pre = 0, push @lines, "</pre>\n" if $pre; + s/<\/?b>//g; + chomp; + $_ = "\n<$hl>$_</$hl>\n"; + $hl = 'h2'; + $emptyline = 0; + } + elsif (/^\s\s\s\S/) { + $pre = 0, push @lines, "</pre>\n" if $pre; + s/(?:^\s+)?<\/?b>//g; + chomp; + $_ = "\n<h3> $_</h3>\n"; + $emptyline = 0; + } + else { + $pre = 1, push @lines, "<pre>\n" unless $pre; + $emptyline = 0, push @lines, "\n" if $emptyline; + } + push @lines, $_; + } + $lines[0] =~ s/^\n//; + $k = "$ARGV[1]/manpages/$k.mdwn"; + open O, '>', $k or die; + print STDOUT 'Writing ', "'$k'\n"; + select O; + my $pe = ''; + foreach (@lines) { + if ($pe) { + if (s/^(\s+)<b>([^<]+)<\/b>\((\d+)\)//) { + my $link = maymakelink "$pe-$2-$3"; + $link = maymakelink "$pe$2-$3" unless $link; + if ($link) { + print "<a href='$link'>$pe-</a>\n"; + print "$1<a href='$link'>$2</a>($3)"; + } + else { + print "<b>$pe-</b>\n"; + print "$1<b>$2</b>($3)"; + } + } else { + print "<b>$pe-</b>\n"; + } + $pe = ''; + } + s/<b>([^<]+)<\/b>\((\d+)\)/mayconvert($1, $2)/ge; + $pe = $1 if s/<b>([^<]+)-<\/b>\s*$//; + print $_; + } +} + +sub maymakelink($) +{ +# warn "$_[0]\n"; + return "../$_[0]/" if exists $fhash{$_[0]}; + return ''; +} + +sub mayconvert($$) +{ + my $f = "$_[0]-$_[1]"; +# warn "$f\n"; + return "<a href='../$f/'>$_[0]</a>($_[1])" if exists $fhash{$f}; + return "<b>$_[0]</b>($_[1])"; +} + +# Finally, make manpages.mdwn + +open O, '>', $ARGV[1] . '/manpages.mdwn' or die $!; +print STDOUT "Writing '$ARGV[1]/manpages.mdwn'\n"; +select O; +print "Manual page index\n"; +print "=================\n\n"; + +sub srt { my ($x, $y) = ($a, $b); $x =~ tr/./-/; $y =~ tr/./-/; $x cmp $y; } + +foreach (sort srt values %fhash) +{ + my $in = $_; + open I, '<', $in or die $!; + my $s; + while (<I>) { + if (/^\s*[.]TH\s+\S+\s+(\S+)/) { + $s = $1; + last; + } + } + while (<I>) { + last if /^\s*[.]SH NAME/ + } + my $line = ''; + while (<I>) { + tr/\\//d; + if (/\s*(\S+)\s+(.*)/) { + my $e = $2; + # Ignoring the NAME in file, get from file name instead. + #my $on = (-l $in)? readlink $in: $in; + my $on = $in; + $on =~ tr/./-/; $on =~ s|.*/||; + my $n = $in; $n =~ s|.*/||; $n =~ tr/./-/; $n =~ s/-[^-]+$//; + $line = "<a href='$on/'>$n</a>($s) $e\n"; + last; + } + } + die "No NAME in '$in'\n" unless $line; + print "* $line"; + #warn $line; +} |