1#!/usr/local/bin/perl
2# Lightly modified man2html to make html equivs of tk/tcl man pages
3# probably a dead end soln since works on output after troff processing
4
5
6# Set the man path array to the paths to search...
7@manpath = ('/usr/share/man','/usr/gnu/man','/usr/local/man');
8#@manpath = ('/s/usr/hops/src/ftp/tcl/tk3.4/docs');
9
10# There has to be a blank line after this...
11#print "Content-type:text/html\n\n";
12
13if (!$ARGV[0]) {
14  print "<isindex>\n";
15  chop($os = `uname`);
16  chop($ver = `uname -r`);
17  print "
18<title> $os $ver Manual Pages </title>
19<h1> $os $ver Manual Pages </h1>
20
21Enter the name of the man page, optionally surrounded
22by parenthesis with the number.  For example:
23<p>
24<ul>
25<li> stat to find one or more man pages for ls
26<li> stat(2) for the system call stat
27</ul>
28
29This converter is still in development.  I intend to
30improve the handling of multiple matches, and add
31a interface to apropos (or man -k (or whatis...))
32<p>
33<a href=\"/users/bcutter/intro.html\">Brooks Cutter</a>
34";
35  exit(0);
36}
37
38$_ = $ARGV[0];
39$manpages[0] = $_;
40if ((/^-$/)) {
41  $manpages[0] = $_;
42} elsif ((m!^/!)) {
43  $manpages[0] = $_;
44#} elsif (($name, $sect) = /(\S+)\((\d.*)\)/) {
45#  @manpages = &findman($name, $sect, @manpath);
46#} elsif (($name, $sect) = /(\S+)<(\d.*)>/) {
47#  @manpages = &findman($name, $sect, @manpath);
48#} elsif (($name, $sect) = /(\S+)\[(\d.*)\]/) {
49#  @manpages = &findman($name, $sect, @manpath);
50#} else {
51#  @manpages = &findman($_, '', @manpath);
52}
53
54if (!scalar @manpages) {
55  print "Sorry, I was unable to find a match for <b>$_</b>\n";
56  exit(0);
57} elsif (scalar @manpages > 1) {
58  &which_manpage(@manpages);
59} else {
60  if (!-e $manpages[0]) {
61    die "man2html: Error, Can't locate file '$manpages[0]'\n";
62  }
63  chop($type=`file -L $manpages[0]`);
64  if ($type =~ /roff/i) {
65    $manpages[0] = "nroff -man $manpages[0]|col -b|";
66  } elsif ($type =~ /text/i) {
67#    #$manpages[0] = $manpages[0];
68#    ; # NOP (No Operation)
69    $manpages[0] = "nroff -man $manpages[0]| col -b|";
70  } else {
71    print "
72<title>Man2HTML: An Error has occurred</title>
73<h1>Man2HTML: An Error has occurred</h1>
74
75man2html found the following match for your query:</hr>
76$manpages[0]
77<p>
78When  'file -L $manpages[0]' was run
79(which should follow symbolic links)
80it returned the following value '$type'
81<p>
82
83";
84  if ($type =~ /link/i) {
85  print "
86This problem appears to be that there is a symbolic link
87for a man page that is pointing to a file that doesn't exist.
88<p>
89";
90  }
91  print "
92Please report this problem to someone who can do something about it.
93<i>(Assuming you aren't that person...)</i>
94If you don't know who that is, try emailing 'root' or 'postmaster'.
95<p>
96There was only one match for your query - and it can't currently
97be accessed.
98";
99  exit(0);
100    #die "Unknown type '$type' for manpage '$manpages[0]'";
101  }
102  &print_manpage($manpages[0]);
103}
104
105exit(0);
106
107sub findman {
108# Take a argument like 'ls' or 'vi(1)' or 'tip(1c)' and return
109# a list of one or more manpages.
110# Arguments 2- are the directories to search in
111  local($lookfor) = shift(@_);
112  local($section) = shift(@_);
113  local($file, @files, @return, $return);
114  local(%men,%man);
115  die "lookfor($lookfor) is null\n" unless($lookfor);
116  for (@_) {
117    # I'm... too lazy... for... opendir()... too lazy for readdir()...
118    # too lazy for closedir() ... I'm too lazy!
119    if (!$section) {
120      @files = `/bin/ls $_/*/$lookfor.* 2> /dev/null`;
121    } else {
122      # if the section is like '1b' then just search *1b
123      # otherwise if '1' search *1* (to catch all sub-sections)
124      # Reason for wildcards: ($_/*$section*/$lookfor.*)
125      # (given $section = '2')
126      # 1st: So it catches cat2 and man2
127      # 2nd: So it catches man2 and man2v
128      # (This should make it compatiable with HP/UX's man2.Z - not tested)
129      # 3rd: So it catches stat.2 and stat.2v
130      #
131      if (length($section) == 1) {
132        @files = `/bin/ls $_/*$section*/$lookfor.* 2> /dev/null`;
133      } else {
134        local($section_num) = substr($section, 0, 1); # Just the number...
135        @files = `/bin/ls $_/*$section_num*/$lookfor.* $_/*$section/$lookfor.* 2> /dev/null`;
136      }
137    }
138    next if (!scalar @files);
139    # This part checks the files that were found...
140    for $file (@files) {
141      chop($file);
142      local(@dirs) = split(/\//,$file);
143      local($fn) = pop(@dirs);
144      local($catman) = pop(@dirs);
145      local($dir) = join('/',@dirs);
146      local($key) = "$dir/$fn";
147      next if ($man{$key}); # forces unique
148      if (!$men{$key}) {
149        $men{$key} = $catman;
150        $man{$key} = $file;
151      } else {
152        # pre-formatted man pages always take precedence unless zero bytes...
153        next if (($men{$key} =~ /^cat/i) && (!(-z $man{$key})));
154        $men{$key} = $catman;
155        $man{$key} = $file;
156      }
157    }
158  }
159  return(values %man);
160}
161
162
163sub which_manpage {
164# Print a list of manpages...
165  print "
166There were multiple matches for the argument '$ARGV[0]'.
167Below are the fully qualified pathnames of the matches, please
168click on the appropriate one.
169
170<ul>
171";
172  for (@_) {
173    print "<li><a href=\"/htbin/man2html?$_\">$_</a>\n";
174  }
175  print "</ul>\n";
176  return;
177}
178
179sub print_manpage {
180  local($page) = @_;
181  local($label, $before, $after, $begtag, $endtag, $blanks, $begtag2, $endtag2);
182  local($pre);
183  local($standard_indent) = 0;
184
185  if ($page eq '-') {
186    open(MAN, '-');
187  } elsif (index($page,'|') == length($page)) {
188    # A Pipe
189    local($eval) =
190'open(MAN, "'.$page.'") || die "Can'."'t open pipe to '$page' for reading: ".'$!";';
191    eval($eval);
192    die "Eval error line $. : '$eval' returned '$@' : $!\n";
193  } else {
194    open(MAN, $page) || die "Can't open '$page' for reading: $!";
195  }
196  while (<MAN>) {
197    s/\|\|*[   ]*$//;      # Delete trailing change bars
198
199    if (/^\s*$/) {
200      $blanks++;
201      #if ($pre) { print "</pre>\n"; $pre = 0; }
202      if (($. != 1) && ($blanks == 1)) {
203        if (($pre) || ($section_pre)) {
204          print "\n";
205        } else {
206          print "<p>\n";
207        }
208      }
209      next;
210    }
211    #next if (!/^[A-Z]{2,}\(.*\).*/);
212    if (//) { s/.//g; }
213    # Escape & < and >
214    s/&/\&amp;/g;
215    s/</\&lt;/g;
216    s/>/\&gt;/g;
217    #
218    if (/^(\w+.*)\s*$/) {
219      $label = $1;
220      $next_action = '';
221      if (/^[A-Z ]{2,}\s*$/) {
222        if (($pre) || ($section_pre)) { print "</pre>\n"; }
223        $pre = $section_pre = $section_fmt = 0;
224        if (!$standard_indent) { $next_action = 'check_indent'; }
225      }
226      if ($label eq 'NAME') {
227        $begtag = '<title>';
228        $endtag = '</title>';
229        $begtag2 = '<h1>';
230        $endtag2 = '</h1>';
231        $next_action = 'check_indent';
232        next;
233      }
234      if ($label eq 'SYNOPSIS') {
235        $section_fmt = 1;
236      }
237      if ($label eq 'SEE ALSO') {
238        $next_action = 'create_links';
239      }
240      if (($label =~ /OPTIONS$/) || ($label eq 'FILES')) {
241        $section_pre = 1;
242       print "</pre>\n";
243#        print "</pre OPTION>\n";
244      } elsif (/^[A-Z ]+\s*$/) {
245        print "</pre>\n" if (($pre) || ($section_pre));
246        $section_pre = 0;
247      }
248print "..$label..\n";
249      if (/^[-A-Z ]+\s*$/) {
250        print "<h2>$label</h2>\n";
251        $blanks = 0;
252        print "<pre>\n" if ($section_pre);
253        next;
254      }
255      next;
256    }
257    if ($section_fmt) { print; $blanks = 0; next; }
258    if ($next_action eq 'create_links') {
259      # Parse see also looking for man page links.  Make it
260      # call this program.  use '+' notation for spaces
261      local($page);
262      local($first) = 1;
263      for $page (split(/,/)) {
264        $page =~ tr/\x00-\x20//d; # Delete all control chars, spaces
265        if ($page =~ /.+\(\d.*\).*$/) {
266          $url_page = $page;
267          $url_page =~ tr/()/[]/;
268          print "," if (!$first);
269          $first = 0;
270          print "<a href=\"/tk2html?$url_page\">$page</a>\n";
271        } else {
272          print "," if (!$first);
273          $first = 0;
274          print "$page";
275        }
276      }
277      next;
278    }
279    # This is to detect preformatted blocks.  I look at the first
280    # line after header 'DESCRIPTION' and count the leading white
281    # space as the "standard indent".  If I encounter a line with
282    # a indent greater than the value of standard_indent then
283    # surround it with <pre> and </pre>
284    if ($next_action eq 'check_indent') {
285      if (/^(\s+)\S+.*/) {
286        $standard_indent = length($1);
287        $next_action = '';
288      }
289    }
290    #
291    $before = length($_);
292    $saved = $_;
293    s/^[   ][   ]*//; # Delete leading whitespace
294    $after = length($_);
295    s/[   ][   ]*$//; # Delete trailing whitespace
296
297    if ($begtag) {
298      chop;
299      print "$begtag$_$endtag\n";
300      print "$begtag2$_$endtag2\n" if ($begtag2);
301      $blanks = 0;
302      $begtag2 = $endtag2 = $begtag = $endtag = '';
303      next;
304    }
305    if ((!$section_fmt) && (!$section_pre) && ($standard_indent)) {
306      if (($blanks == 1) && (!$pre) && ($after + $standard_indent) < $before) {
307        $pre = 1;
308        print "<pre>\n";
309      } elsif (($pre) && ($after + $standard_indent) >= $before) {
310        $pre = 0;
311        print "</pre>\n";
312      }
313    }
314    if (($section_pre) || ($pre)) {
315      print "$saved";
316      $blanks = 0;
317      next;
318    }
319    # Handle word cont-
320    # inuations
321    if ($prefix) {
322      print $prefix;
323      $prefix = '';
324    }
325    if (/^(.+)\s+(\w+)\-\s*$/) {
326      $prefix = $2;
327      print "$1\n";
328      $blanks = 0;
329      next;
330    }
331    print;
332    $blanks = 0;
333  }
334  close(MAN);
335}
336
337# EOF
338