addrutil: Re-indent.
[wk-misc.git] / faqprog.pl
1 #!/usr/bin/env perl
2 #
3 # $Id: faqprog.pl,v 1.1 2005-02-15 13:33:35 werner Exp $
4 #
5 # Convert faq format to postable FAQ/HTML FAQ/or search the FAQ.
6 #
7 # A FAQ looks like this:
8 # <C>   - will be subsituted by new contents.
9 # <S>   - will be replace by section number.
10 # <Q>   - will be replaced by section.sub.
11 # <D>   - defines a symbolic reference to the next question/section
12 # <R>   - resolves a symbolic reference
13 # <K>   - defines keywords for the next question
14 # <s>   - will be replaced by subsection counter
15 # \[H\s*([^]]*)\] - will be replaced by <$1> (HTML tag)
16 # \[\$var=value\] - define (possible multiline) variable, only allowed at start
17 # \[\$var\] - use variable, if defined.
18 #
19 # Written for the Solaris 2 FAQ by Casper.Dik@Holland.Sun.COM
20 #
21 # Copyright (c) 1994-1996, 1998, 2000 by Casper Dik.
22 # All rights reserved.
23
24 # Redistribution and use in source and binary forms, with or without
25 # modification, are permitted provided that the following conditions
26 # are met:
27 # 1. Redistributions of source code must retain the above copyright
28 #    notice, this list of conditions and the following disclaimer.
29 # 2. Redistributions in binary form must reproduce the above copyright
30 #    notice, this list of conditions and the following disclaimer in the
31 #    documentation and/or other materials provided with the distribution.
32 # 3. All advertising materials mentioning features or use of this software
33 #    must display the following acknowledgement:
34 #      This product includes software developed by Casper Dik.
35
36 # THIS SOFTWARE IS PROVIDED BY THE CASPER DIK ``AS IS'' AND ANY EXPRESS
37 # OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
38 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
39 # DISCLAIMED.  IN NO EVENT SHALL CASPER DIK BE LIABLE FOR ANY DIRECT,
40 # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
41 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
42 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
43 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
44 # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
45 # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
46 # POSSIBILITY OF SUCH DAMAGE.
47
48
49 require "getopts.pl";
50 umask (022);
51
52 $opt_h = !!($0 =~ /html/);
53 $opt_s = !!($0 =~ /sfaq/);
54 $opt_l = 1;
55 $opt_m = 5;
56
57 if (!&Getopts('VSf:m:hsl:') || ($#ARGV < 0 && $opt_s)) {
58     print STDERR "Usage: $0 [-S] [-h] [-f faq] [output]\n";
59     print STDERR "Usage: $0 -s [-m max] [-l 0|1|2] [-f faq] expr ...\n";
60     exit 255;
61 }
62
63 if ( $opt_V ) {
64     print "faqprog.pl 1.0\n";
65     exit 0;
66 }
67
68 $faq = $opt_f || $ENV{'FAQSOURCE'} || die "$0: no FAQ specified\n";
69 $opt_f = "keep perl -w happy";
70 $tmpf = "/tmp/convert.$$";
71 $trailer = "</body></html>\n";
72 open(SRC, "<$faq") || die;
73
74 $Q = "#q"; $E = "";
75 if ($opt_s) {
76     $maxmatch = $opt_m;
77 } else {
78     open(TMP, ">$tmpf") || die;
79     if ($#ARGV == 0) {
80         $out = shift;
81         if ($opt_S) {
82             die "Can't make $out" if (!mkdir($out, 0755) && ! -d $out);
83             $Q = "Q";
84             $E = ".html";
85             open(POST, ">$out/index.html") || die;
86         } else {
87             open(POST, ">$out") || die;
88         }
89     } else {
90         $out = "(stdout)";
91         die "-S requires output name\n" if defined($opt_S);
92         open(POST, ">&STDOUT") || die;
93     }
94 }
95
96 $xref = "$faq.xref";
97
98 if (-f "$xref") {
99     open(XREF,"<$xref");
100     while(<XREF>) {
101         m/(.*)\0(.*)/;
102         $ref{$1} = $2;
103     }
104     close(XREF);
105 }
106
107 print STDERR "Converting $faq to $out",
108         $opt_h ? $opt_S ? " (split-html)" : " (html)" : "" , "\n"
109     unless($opt_s);
110
111 $section = 0;
112 $question = 0;
113
114 $file = "POST" unless ($opt_s);
115
116 #
117 # Read initial variable definitions.
118 #
119 while (<SRC>) {
120     if (/^\[\$([a-zA-Z]+)=([^]]*)(\])?/) {
121         if (!defined($3) || $3 ne "]") {
122             $_ .= <SRC>;
123             redo;
124         }
125         $var = $1;
126         $value = $2;
127         $value =~ s/^\n// if ($value =~ /^\n/);
128         $vars{$var} = $value;
129     } else {
130         last;
131     }
132 }
133
134 if ($opt_s) {
135     while(<SRC>) {
136         last if (/<S>/);
137     }
138     $section = 1;
139     for (@ARGV) { $_ = "\Q$_\E" ; s/\s+/\s+/g ; }
140     $expr = "(" . join(")|(",@ARGV) . ")";
141
142     $prints = 0;
143     $printcurrent = 0;
144     @qrefs = ();
145     $qtext = "";
146 } elsif ($opt_h) {
147     print POST &mktitle();
148 } else {
149     print POST &getvar('usenetheader'), "\n";
150 }
151
152 $in_q = 0;
153 $in_pre = 0;
154
155 #
156 # <IF expr> ..[<ELSE>|<ELSIF expr>].. <FI> (not yet implemented)
157 #
158 #@if_list = ();
159 #$showoutput = 1;
160
161 main: while (<SRC>) {
162     if (/\[\$([a-zA-Z]+)\s*\]/) {
163         $_ = $` . &getvar($1) . $';
164         redo;
165     }
166     # Remove http stuff.
167     if ((($slash,$tag) = m:^\s*\[H\s*(/)?([^]]*)\]\s*$:)) {
168         $in_pre = !defined($slash) if ($tag eq "pre");
169         next unless ($opt_h);
170     }
171     if (!$opt_h) { 
172         $url = $' if (s/\[H\s*([aA][^]]+)\]/\001/ && $1 =~ /href=/i && ! /(:\/|ftp|http)/);
173         if (defined $url) {
174             if (length($_) + length($url) < 75) {
175                 chomp;
176             } else {
177                 $_ .= "\t   ";
178             }
179             $_ .= " <$url>\n";
180             undef $url;
181         }
182         s/\001//;
183         s:\[H\s*/?B\]:*:g;
184         s/\[H\s*[^]]*\]//og;
185         s/^\s+$/\n/;
186     }
187     if (/^<C>/) {
188         next if ($opt_s);
189         print POST "<menu>\n" if ($opt_h);
190         $file = "TMP";
191     } elsif (/^<D([^>]*)>/) {
192         $newref = $1;
193         next;
194     } elsif (/^<K([^>]*)>/) {
195         $newkey = $1;
196         next;
197     } elsif (/<R([^>]*)>/) {
198         # Replace <Rref> w/ $ref{ref})
199         $thisref = &get_ref($1);
200         local($pre,$post) = ($`, $');
201         push(@qrefs,$thisref) if ($opt_s);
202         $thisref = "[H a HREF=$Q$thisref$E]${thisref}[H/a]"
203                 if ($opt_h && !($in_q || /<Q>/));
204         $_ = $pre.$thisref.$post;
205         redo main;
206     } elsif ($in_q) {
207         if (/^$/) {
208             $in_q = 0;
209             if ($opt_h) {
210                 if ($opt_s) {
211                     $_ = "</h3>\n";
212                 } else {
213                     print TMP "</h3>\n";
214                     print POST "</a>\n";
215                 }
216             }
217             redo main unless $opt_s;
218         }
219         if (!$opt_s) {
220             &htmlize($_) if $opt_h;
221             print TMP $_;
222             s/^\s*/     / unless ($opt_h);
223             print POST $_;
224         }
225     } elsif (/<Q>/) {
226         $subsection = 0;
227         $question++;
228         $in_q = 1;
229         $ref = "$section.$question";
230         &mkref($ref,"Question");
231         $_ = $';
232         &htmlize($_) if $opt_h;
233         if ($opt_s) {
234             &store_q;
235             if ($opt_h) {
236                 $_ = "<h3>\n<a NAME=q$ref>$ref)</a>$_";
237             } else {
238                 $_ = "$`$ref)$_";
239             }
240             $kwmatch = defined($newkey);
241             $kwmatch ++ if ($kwmatch && "$newkey $ref" =~ m/$expr/io);
242             undef $newkey;
243             #print STDERR $_;
244         } elsif ($opt_h) {
245             print TMP "<h3>\n<a NAME=q$ref>$ref)</a>$_";
246             print POST "<LI><a HREF=$Q$ref$E>$ref)$_";
247         } else {
248             $tmp = $`;
249             $tmp = " " if (length($tmp) == 0);
250             print TMP "$`$ref)$'";
251             print POST "  $tmp$ref)$'";
252         }
253     } elsif (/<S>/) {
254         $section++;
255         $line = "$section.$'";
256         &mkref($section,"Section");
257         &htmlize($line) if ($opt_h);
258         if ($opt_s) {
259             &store_q;
260         } elsif ($opt_h) {
261             print TMP "<h2>\n<A NAME=q$section>$line</A></h2>\n";
262             print POST "<h2><A HREF=$Q$section$E>$line</A></h2>\n";
263         } else {
264             $tmp = $`;
265             $tmp = " " if (length($tmp) == 0);
266             print TMP $line;
267             print POST "\n$tmp$line";
268         }
269         $subsection = 0;
270         $question = 0;
271     } elsif (/<s>/) {
272         $subsection++;
273         $_ = $`. ($last ne "<P>\n" && $opt_h ? '[H BR]' : "") . "$subsection)$'";
274         &htmlize($_) if $opt_h;
275         print TMP $_ unless ($opt_s);
276     } else {
277         if ($opt_h) {
278             $_ = $' if (/^    /);
279             &htmlize($_);
280         }
281         print $file $_ unless ($opt_s);
282     }
283     if ($opt_s) {
284         if (!$printcurrent && ($kwmatch == 2 || !$kwmatch && /$expr/io)) {
285             $prints ++;
286             die "Too many matching questions\n"
287                 if ($maxmatch > 0 && $prints > $maxmatch);
288             $printcurrent = 1;
289         }
290         $qtext .= $_;
291     }
292     $last = $_;
293 }
294
295 if ($opt_s) {
296     if ($prints) {
297         $output = ""; $cheat = 0; $mods = 0;
298         foreach $q (sort sortq keys(%qprint)) {
299             $cheat ++ if ($qtext{$q} =~ /^\+/);
300             $mods ++ if ($qtext{$q} =~ /^\*/);
301             $output .= $qtext{$q};
302         }
303         if ($cheat) {
304             print "The FAQ maintainer cheated and added this to the FAQ:\n\n";
305         } else {
306             print &getvar('sfaqheader'), "\n\n";
307         }
308         print $output;
309         print "    --- end of excerpt from the FAQ\n\n";
310         print
311             "Questions marked with a * or + have been changed or added since\n",
312             "the FAQ was last posted\n\n" if ($mods || $cheat);
313         print
314             &getvar('sfaqfooter') unless ($opt_h);
315     } else {
316         print "No matching questions\n";
317     }
318 } else {
319     &mkref();
320     print POST "</menu>\n" if ($opt_h);
321     unless ($opt_S) {
322         open(TMP, "<$tmpf") || die;
323         print POST $_ while <TMP>;
324     }
325     close(TMP);
326     unlink "$tmpf";
327     print POST $trailer if ($opt_h);
328 }
329     if (defined($refchanged)) {
330         print STDERR "$0: writing $xref\n";
331         open(XREF,">$xref");
332         foreach $k (keys(%newref)) {
333             print XREF "$k\0$newref{$k}\n";
334         }
335         close(XREF);
336         exit 1;
337     }
338 exit 0;
339
340 #
341 # Do two levels of references only.
342 #
343 sub store_q {
344     #print $qtext if ($printcurrent);
345  
346     if (defined($lastq)) {
347         $qtext{$lastq} = $qtext;
348         $qrefs{$lastq} = join(":",@qrefs);
349         if ($printcurrent) {
350             $qprint{$lastq} = 1;
351             if ($opt_l >= 1) {
352                 foreach $r (@qrefs) {
353                     $qprint{$r} = 1;
354                     if ($opt_l >= 2 && defined($qrefs{$r})) {
355                         foreach $r2 (split(':',$qrefs{$r})) {
356                             $qprint{$r2} = 1;
357                         }
358                     }
359                 }
360             }
361         }
362     }
363
364     if (defined($lastq) && $lastq eq $ref) {
365         undef $lastq;
366     } else {
367         $lastq = $ref if (defined($ref));
368     }
369
370     $printcurrent = 0;
371     $qtext = "";
372     @qrefs = ();
373 }
374
375 sub add_ref {
376     local($qref,$ref) = @_;
377
378     if (!defined($ref{$qref}) || $ref{$qref} ne $ref) {
379         unless (defined($refchanged)) {
380             warn "$0: references changed, rerun\n";
381             $refchanged = 1;
382         }
383         $ref{$qref} = $ref;
384     }
385     $newref{$qref} = $ref;
386 }
387
388 sub get_ref {
389     local($qref) = @_;
390
391     if (!defined($ref{$qref})) {
392         warn "$0: no reference \"$qref\"\n";
393         "error in FAQ: no reference \"$qref\"";
394     } else {
395         $ref{$qref};
396     }
397 }
398
399 sub sortq {
400     local(@q1,@q2);
401
402     @q1 = split('\.', $a);
403     @q2 = split('\.', $b);
404
405     $q1[0] <=> $q2[0] || $q1[1] <=> $q2[1];
406 }
407
408 sub htmlize {
409     if ($_[0] =~ /^$/) {
410         $_[0] = "<P>\n" unless ($in_pre);
411     } elsif ($_[0] =~ /[&<>"\[]/) {
412         if (! $in_pre) {
413             $_[0] =~ s/&/\&amp;/g;
414             $_[0] =~ s/"/\&quot;/g;
415         }
416         $_[0] =~ s/>/\&gt;/g;
417         $_[0] =~ s/</\&lt;/g;
418         $_[0] =~ s/\[H\s*([^]]*)\]/<$1>/g;
419     }
420 }
421
422 sub getvar {
423     local($v) = $vars{$_[0]};
424     unless (defined($v)) {
425         warn "\$$_[0] not defined in FAQ\n";
426          "FAQ source ERROR: '\$$_[0]' not defined";
427     } else {
428         $v;
429     }
430 }
431 sub mktitle {
432     local($q) = @_;
433     "<html><head>\n<title>" .
434     &getvar('htmltitle') . (defined($q) ? " $q" : "") . "</title>\n" .
435     &getvar('htmlcharset') . (defined($q) ? " $q" : "") . 
436     "\n</head>\n<body>\n";
437 }
438
439 sub mkref {
440     local($next, $title) = @_;
441
442     if (!$opt_S) {
443         if (defined($newref) && defined($next)) {
444             &add_ref($newref,$next);
445             undef $newref;
446         }
447         return;
448     }
449     if (defined($PrevQ)) {
450         print TMP "<A HREF=$Q$PrevQ$E>PREV</A>\n";
451     }
452     print TMP "<A HREF=index.html>INDEX</A>\n";
453     if (defined($next)) {
454         print TMP "<A HREF=$Q$next$E>NEXT</A>\n";
455         $PrevQ = $CurQ if (defined $CurQ);
456         $CurQ = $next;
457     }
458     print TMP $trailer;
459     if (defined($next)) {
460         open(TMP,">$out/$Q$next$E");
461         print TMP &mktitle("$title $next");
462     }
463 }
464