<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/env perl
#
# $Id: faqprog.pl,v 1.22 2000/09/05 12:03:15 casper Exp $
#
# Convert faq format to postable FAQ/HTML FAQ/or search the FAQ.
#
# A FAQ looks like this:
# &lt;C&gt;	- will be subsituted by new contents.
# &lt;S&gt;	- will be replace by section number.
# &lt;Q&gt;	- will be replaced by section.sub.
# &lt;D&gt;	- defines a symbolic reference to the next question/section
# &lt;R&gt;	- resolves a symbolic reference
# &lt;K&gt;	- defines keywords for the next question
# &lt;s&gt;	- will be replaced by subsection counter
# \[H\s*([^]]*)\] - will be replaced by &lt;$1&gt; (HTML tag)
# \[\$var=value\] - define (possible multiline) variable, only allowed at start
# \[\$var\] - use variable, if defined.
#
# Written for the Solaris 2 FAQ by Casper.Dik@Holland.Sun.COM
#
# Copyright (c) 1994-1996, 1998, 2000 by Casper Dik.
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#      This product includes software developed by Casper Dik.
# 
# THIS SOFTWARE IS PROVIDED BY THE CASPER DIK ``AS IS'' AND ANY EXPRESS
# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED.  IN NO EVENT SHALL CASPER DIK BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# 

require "getopts.pl";
umask (022);

$opt_h = !!($0 =~ /html/);
$opt_s = !!($0 =~ /sfaq/);
$opt_l = 1;
$opt_m = 5;

if (!&amp;Getopts('VSf:m:hsl:') || ($#ARGV &lt; 0 &amp;&amp; $opt_s)) {
    print STDERR "Usage: $0 [-S] [-h] [-f faq] [output]\n";
    print STDERR "Usage: $0 -s [-m max] [-l 0|1|2] [-f faq] expr ...\n";
    exit 255;
}

if ( $opt_V ) {
    print "faqprog.pl 1.0\n";
    exit 0;
}

$faq = $opt_f || $ENV{'FAQSOURCE'} || die "$0: no FAQ specified\n";
$opt_f = "keep perl -w happy";
$tmpf = "/tmp/convert.$$";
$trailer = "&lt;/body&gt;&lt;/html&gt;\n";
open(SRC, "&lt;$faq") || die;

$Q = "#q"; $E = "";
if ($opt_s) {
    $maxmatch = $opt_m;
} else {
    open(TMP, "&gt;$tmpf") || die;
    if ($#ARGV == 0) {
	$out = shift;
	if ($opt_S) {
	    die "Can't make $out" if (!mkdir($out, 0755) &amp;&amp; ! -d $out);
	    $Q = "Q";
	    $E = ".html";
	    open(POST, "&gt;$out/index.html") || die;
	} else {
	    open(POST, "&gt;$out") || die;
	}
    } else {
	$out = "(stdout)";
	die "-S requires output name\n" if defined($opt_S);
	open(POST, "&gt;&amp;STDOUT") || die;
    }
}

$xref = "$faq.xref";

if (-f "$xref") {
    open(XREF,"&lt;$xref");
    while(&lt;XREF&gt;) {
	m/(.*)\0(.*)/;
	$ref{$1} = $2;
    }
    close(XREF);
}

print STDERR "Converting $faq to $out",
	$opt_h ? $opt_S ? " (split-html)" : " (html)" : "" , "\n"
    unless($opt_s);

$section = 0;
$question = 0;

$file = "POST" unless ($opt_s);

#
# Read initial variable definitions.
#
while (&lt;SRC&gt;) {
    if (/^\[\$([a-zA-Z]+)=([^]]*)(\])?/) {
	if (!defined($3) || $3 ne "]") {
	    $_ .= &lt;SRC&gt;;
	    redo;
	}
	$var = $1;
	$value = $2;
	$value =~ s/^\n// if ($value =~ /^\n/);
	$vars{$var} = $value;
    } else {
	last;
    }
}

if ($opt_s) {
    while(&lt;SRC&gt;) {
	last if (/&lt;S&gt;/);
    }
    $section = 1;
    for (@ARGV) { $_ = "\Q$_\E" ; s/\s+/\s+/g ; }
    $expr = "(" . join(")|(",@ARGV) . ")";

    $prints = 0;
    $printcurrent = 0;
    @qrefs = ();
    $qtext = "";
} elsif ($opt_h) {
    print POST &amp;mktitle();
} else {
    print POST &amp;getvar('usenetheader'), "\n";
}

$in_q = 0;
$in_pre = 0;

#
# &lt;IF expr&gt; ..[&lt;ELSE&gt;|&lt;ELSIF expr&gt;].. &lt;FI&gt; (not yet implemented)
#
#@if_list = ();
#$showoutput = 1;

main: while (&lt;SRC&gt;) {
    if (/\[\$([a-zA-Z]+)\s*\]/) {
	$_ = $` . &amp;getvar($1) . $';
	redo;
    }
    # Remove http stuff.
    if ((($slash,$tag) = m:^\s*\[H\s*(/)?([^]]*)\]\s*$:)) {
	$in_pre = !defined($slash) if ($tag eq "pre");
	next unless ($opt_h);
    }
    if (!$opt_h) { 
	$url = $' if (s/\[H\s*([aA][^]]+)\]/\001/ &amp;&amp; $1 =~ /href=/i &amp;&amp; ! /(:\/|ftp|http)/);
	if (defined $url) {
	    if (length($_) + length($url) &lt; 75) {
		chomp;
	    } else {
		$_ .= "\t   ";
	    }
	    $_ .= " &lt;$url&gt;\n";
	    undef $url;
	}
	s/\001//;
	s:\[H\s*/?B\]:*:g;
	s/\[H\s*[^]]*\]//og;
	s/^\s+$/\n/;
    }
    if (/^&lt;C&gt;/) {
	next if ($opt_s);
	print POST "&lt;menu&gt;\n" if ($opt_h);
	$file = "TMP";
    } elsif (/^&lt;D([^&gt;]*)&gt;/) {
	$newref = $1;
	next;
    } elsif (/^&lt;K([^&gt;]*)&gt;/) {
	$newkey = $1;
	next;
    } elsif (/&lt;R([^&gt;]*)&gt;/) {
	# Replace &lt;Rref&gt; w/ $ref{ref})
	$thisref = &amp;get_ref($1);
	local($pre,$post) = ($`, $');
	push(@qrefs,$thisref) if ($opt_s);
	$thisref = "[H a HREF=$Q$thisref$E]${thisref}[H/a]"
		if ($opt_h &amp;&amp; !($in_q || /&lt;Q&gt;/));
	$_ = $pre.$thisref.$post;
	redo main;
    } elsif ($in_q) {
	if (/^$/) {
	    $in_q = 0;
	    if ($opt_h) {
		if ($opt_s) {
		    $_ = "&lt;/h3&gt;\n";
		} else {
		    print TMP "&lt;/h3&gt;\n";
		    print POST "&lt;/a&gt;\n";
		}
	    }
	    redo main unless $opt_s;
	}
	if (!$opt_s) {
	    &amp;htmlize($_) if $opt_h;
	    print TMP $_;
	    s/^\s*/	/ unless ($opt_h);
	    print POST $_;
	}
    } elsif (/&lt;Q&gt;/) {
	$subsection = 0;
	$question++;
	$in_q = 1;
	$ref = "$section.$question";
	&amp;mkref($ref,"Question");
	$_ = $';
	&amp;htmlize($_) if $opt_h;
	if ($opt_s) {
	    &amp;store_q;
	    if ($opt_h) {
		$_ = "&lt;h3&gt;\n&lt;a NAME=q$ref&gt;$ref)&lt;/a&gt;$_";
	    } else {
		$_ = "$`$ref)$_";
	    }
	    $kwmatch = defined($newkey);
	    $kwmatch ++ if ($kwmatch &amp;&amp; "$newkey $ref" =~ m/$expr/io);
	    undef $newkey;
	    #print STDERR $_;
	} elsif ($opt_h) {
	    print TMP "&lt;h3&gt;\n&lt;a NAME=q$ref&gt;$ref)&lt;/a&gt;$_";
	    print POST "&lt;LI&gt;&lt;a HREF=$Q$ref$E&gt;$ref)$_";
	} else {
	    $tmp = $`;
	    $tmp = " " if (length($tmp) == 0);
	    print TMP "$`$ref)$'";
	    print POST "  $tmp$ref)$'";
	}
    } elsif (/&lt;S&gt;/) {
	$section++;
	$line = "$section.$'";
	&amp;mkref($section,"Section");
	&amp;htmlize($line) if ($opt_h);
	if ($opt_s) {
	    &amp;store_q;
	} elsif ($opt_h) {
	    print TMP "&lt;h2&gt;\n&lt;A NAME=q$section&gt;$line&lt;/A&gt;&lt;/h2&gt;\n";
	    print POST "&lt;h2&gt;&lt;A HREF=$Q$section$E&gt;$line&lt;/A&gt;&lt;/h2&gt;\n";
	} else {
	    $tmp = $`;
	    $tmp = " " if (length($tmp) == 0);
	    print TMP $line;
	    print POST "\n$tmp$line";
	}
	$subsection = 0;
	$question = 0;
    } elsif (/&lt;s&gt;/) {
	$subsection++;
	$_ = $`. ($last ne "&lt;P&gt;\n" &amp;&amp; $opt_h ? '[H BR]' : "") . "$subsection)$'";
	&amp;htmlize($_) if $opt_h;
	print TMP $_ unless ($opt_s);
    } else {
	if ($opt_h) {
	    $_ = $' if (/^    /);
	    &amp;htmlize($_);
	}
	print $file $_ unless ($opt_s);
    }
    if ($opt_s) {
	if (!$printcurrent &amp;&amp; ($kwmatch == 2 || !$kwmatch &amp;&amp; /$expr/io)) {
	    $prints ++;
	    die "Too many matching questions\n"
		if ($maxmatch &gt; 0 &amp;&amp; $prints &gt; $maxmatch);
	    $printcurrent = 1;
	}
	$qtext .= $_;
    }
    $last = $_;
}

if ($opt_s) {
    if ($prints) {
	$output = ""; $cheat = 0; $mods = 0;
	foreach $q (sort sortq keys(%qprint)) {
	    $cheat ++ if ($qtext{$q} =~ /^\+/);
	    $mods ++ if ($qtext{$q} =~ /^\*/);
	    $output .= $qtext{$q};
	}
	if ($cheat) {
	    print "The FAQ maintainer cheated and added this to the FAQ:\n\n";
	} else {
	    print &amp;getvar('sfaqheader'), "\n\n";
	}
	print $output;
	print "    --- end of excerpt from the FAQ\n\n";
	print
	    "Questions marked with a * or + have been changed or added since\n",
	    "the FAQ was last posted\n\n" if ($mods || $cheat);
	print
	    &amp;getvar('sfaqfooter') unless ($opt_h);
    } else {
	print "No matching questions\n";
    }
} else {
    &amp;mkref();
    print POST "&lt;/menu&gt;\n" if ($opt_h);
    unless ($opt_S) {
	open(TMP, "&lt;$tmpf") || die;
	print POST $_ while &lt;TMP&gt;;
    }
    close(TMP);
    unlink "$tmpf";
    print POST $trailer if ($opt_h);
}
    if (defined($refchanged)) {
	print STDERR "$0: writing $xref\n";
	open(XREF,"&gt;$xref");
	foreach $k (keys(%newref)) {
	    print XREF "$k\0$newref{$k}\n";
	}
	close(XREF);
	exit 1;
    }
exit 0;

#
# Do two levels of references only.
#
sub store_q {
    #print $qtext if ($printcurrent);
 
    if (defined($lastq)) {
	$qtext{$lastq} = $qtext;
	$qrefs{$lastq} = join(":",@qrefs);
	if ($printcurrent) {
	    $qprint{$lastq} = 1;
	    if ($opt_l &gt;= 1) {
		foreach $r (@qrefs) {
		    $qprint{$r} = 1;
		    if ($opt_l &gt;= 2 &amp;&amp; defined($qrefs{$r})) {
			foreach $r2 (split(':',$qrefs{$r})) {
			    $qprint{$r2} = 1;
			}
		    }
		}
	    }
	}
    }

    if (defined($lastq) &amp;&amp; $lastq eq $ref) {
	undef $lastq;
    } else {
	$lastq = $ref if (defined($ref));
    }

    $printcurrent = 0;
    $qtext = "";
    @qrefs = ();
}

sub add_ref {
    local($qref,$ref) = @_;

    if (!defined($ref{$qref}) || $ref{$qref} ne $ref) {
	unless (defined($refchanged)) {
	    warn "$0: references changed, rerun\n";
	    $refchanged = 1;
	}
	$ref{$qref} = $ref;
    }
    $newref{$qref} = $ref;
}

sub get_ref {
    local($qref) = @_;

    if (!defined($ref{$qref})) {
	warn "$0: no reference \"$qref\"\n";
	"error in FAQ: no reference \"$qref\"";
    } else {
	$ref{$qref};
    }
}

sub sortq {
    local(@q1,@q2);

    @q1 = split('\.', $a);
    @q2 = split('\.', $b);

    $q1[0] &lt;=&gt; $q2[0] || $q1[1] &lt;=&gt; $q2[1];
}

sub htmlize {
    if ($_[0] =~ /^$/) {
	$_[0] = "&lt;P&gt;\n" unless ($in_pre);
    } elsif ($_[0] =~ /[&amp;&lt;&gt;"\[]/) {
	if (! $in_pre) {
	    $_[0] =~ s/&amp;/\&amp;amp;/g;
	    $_[0] =~ s/"/\&amp;quot;/g;
	}
	$_[0] =~ s/&gt;/\&amp;gt;/g;
	$_[0] =~ s/&lt;/\&amp;lt;/g;
	$_[0] =~ s/\[H\s*([^]]*)\]/&lt;$1&gt;/g;
    }
}

sub getvar {
    local($v) = $vars{$_[0]};
    unless (defined($v)) {
	warn "\$$_[0] not defined in FAQ\n";
	 "FAQ source ERROR: '\$$_[0]' not defined";
    } else {
	$v;
    }
}
sub mktitle {
    local($q) = @_;
    "&lt;html&gt;&lt;head&gt;\n&lt;title&gt;" .
	&amp;getvar('htmltitle') .  (defined($q) ? " $q" : "") .
	"&lt;/title&gt;\n&lt;/head&gt;\n&lt;body&gt;\n";
}

sub mkref {
    local($next, $title) = @_;

    if (!$opt_S) {
	if (defined($newref) &amp;&amp; defined($next)) {
	    &amp;add_ref($newref,$next);
	    undef $newref;
	}
	return;
    }
    if (defined($PrevQ)) {
	print TMP "&lt;A HREF=$Q$PrevQ$E&gt;PREV&lt;/A&gt;\n";
    }
    print TMP "&lt;A HREF=index.html&gt;INDEX&lt;/A&gt;\n";
    if (defined($next)) {
	print TMP "&lt;A HREF=$Q$next$E&gt;NEXT&lt;/A&gt;\n";
	$PrevQ = $CurQ if (defined $CurQ);
	$CurQ = $next;
    }
    print TMP $trailer;
    if (defined($next)) {
	open(TMP,"&gt;$out/$Q$next$E");
	print TMP &amp;mktitle("$title $next");
    }
}
</pre></body></html>