htdocs/FAQ/faq.pl

   1 package FAQ;
   2
   3 my ($faq,$var,$env,$q,$a,$c,$s,$t,$n);
   4 my (@faq,%Q,%A,@s);
   5 my @sections = qw'Meta User Admin Misc';
   6
   7 @faq = ($faq) = $ENV{PATH_INFO} =~ /(\w+).html/;
   8 @faq = map {lc} @sections if $faq eq 'all';
   9
  10 print "<style type=text/css><!-- h2,h3 {font-weight:normal} --></style>\n";
  11
  12 print '<h1><a name="top" href="/index.html">F*EX</a> ';
  13 printf "Frequently Asked Questions: %s</h1>\n",ucfirst($faq);
  14
  15 if ($faq ne 'local') {
  16   print "<h3>Sections: ";
  17   foreach $s (@sections,'All') {
  18     if ($s =~ /$faq/i) {
  19       print "<b>$s</b>\n";
  20     } else {
  21       printf "[<a href=\"%s.html\">%s</a>]\n",lc($s),$s;
  22     }
  23   }
  24   print "</h3>\n";
  25 }
  26
  27 print "<p><hr><p>\n";
  28 print "<table>\n";
  29
  30 foreach my $faq (@faq) {
  31   open $faq,"$faq.faq" or next;
  32   local $/ = "Q:";
  33   local $_ = <$faq>;
  34   while (<$faq>) {
  35     chomp;
  36     while (/\$([\w_]+)\$/) {
  37       $var = $1;
  38       $env = $ENV{$var} || '';
  39       # s/\$$var\$/<code>$env<\/code>/g;
  40       s/\$$var\$/$env/g;
  41     };
  42     ($q,$a) = split /A:\s*/;
  43     $q =~ s/[\s\n]+$//;
  44     $q =~ s/^\s+//;
  45     $q =~ s! (/\w[\S]+/[\S]+)! <code>$1</code>!g;
  46     $a =~ s/[\s\n]+$/\n/;
  47     $a =~ s/^\s+//;
  48     while ($a =~ s/^(\s*)\*/$1<ul>\n$1<li>/m) {
  49       while ($a =~ s/(<li>.*\n\s*)\*/$1<li>/g) {}
  50       $a =~ s:(.*\n)(\s*)(<li>[^\n]+\n):$1$2$3$2</ul>\n:s
  51     }
  52     $a =~ s/\n\n/\n<p>\n/g;
  53     $a =~ s/([^>\n\\])\n/$1<br>\n/g;
  54     $a =~ s/<pre>(.+?)<\/pre>/pre($1)/ges;
  55     $a =~ s/\\\n/\n/g;
  56 #    $a =~ s/^\s*<br>\s*//mg;
  57     $a =~ s/<([^\s<>\@]+\@[\w.-]+)>/<a href="mailto:$1">&lt;$1><\/a>/g;
  58     $a =~ s! (/\w[\S]+/[\S]+)! <code>$1</code>!g;
  59     $a =~ s!(https?://[\w-]+\.[^\s<>()]+)!<a href="$1">[$1]</a>!g or
  60     $a =~ s!(https?://[^\s<>()]+)!<code>$1</code></a>!g;
  61     push @{$Q{$faq}},$q;
  62     push @{$A{$faq}},$a;
  63   }
  64   close $faq;
  65 }
  66
  67 print "<table>\n";
  68
  69 foreach $s (sections($faq)) {
  70
  71   $c = lc $s;
  72   $s = '' if $s eq 'Local';
  73   $t = '';
  74   $t = $s if $faq eq 'all';
  75
  76   for ($n = 0; $n < scalar(@{$Q{$c}}); $n++) {
  77     $q = ${Q{$c}[$n]};
  78     $qa = anchor($q);
  79     printf '<tr valign=top><th align=left>'.
  80            '<a href="#%s%d" style="text-decoration: none">'.
  81            '<font color="black">%s&nbsp;Q%d</a>:'.
  82            '<td><a href="#%s">%s</a></tr>'."\n",
  83            $t,$n+1,$s,$n+1,$qa,$q;
  84   }
  85 }
  86
  87 print "</table>\n";
  88 print "<p><hr><p>\n";
  89
  90 foreach $s (sections($faq)) {
  91
  92   $c = lc $s;
  93   $s = '' if $s eq 'Local';
  94   $t = '';
  95   $t = $s if $faq eq 'all';
  96
  97   for ($n = 0; $n < scalar(@{$Q{$c}}); $n++) {
  98     $q = ${Q{$c}[$n]};
  99     $qa = anchor($q);
 100     print "<p>\n";
 101     print "<table>\n";
 102     printf "<tr valign=top><th>".
 103            "<a name=\"%s%d\">%s&nbsp;Q%d:</a>".
 104            "<a name=\"%s\"></a>".
 105            "<td><b>%s</b></tr>\n",
 106            $t,$n+1,$s,$n+1,$qa,$q;
 107     printf "<tr valign=top><th>%s&nbsp;A%d:<td>\n%s</tr>\n",
 108            $s,$n+1,${A{$c}[$n]};
 109     print "</table>\n";
 110     print "[<a href=\"#top\">&uarr;&nbsp;Questions</a>]\n";
 111   }
 112 }
 113
 114 print "<pre>\n";
 115 print "\n" x 99;
 116 print "</pre>\n";
 117
 118
 119 sub sections {
 120   my $faq = shift;
 121   if ($faq eq 'all') {
 122     return @sections;
 123   } else {
 124     return ucfirst($faq);
 125   }
 126 }
 127
 128 sub pre {
 129   local $_ = shift;
 130   s/<br>//g;
 131   s/\s+$//;
 132   return "<pre>$_</pre>\n";
 133 }
 134
 135 sub anchor {
 136   local $_ = shift;
 137   s/<.+?>//g;
 138   s/\(.+?\)//g;
 139   s/\W/_/g;
 140   s/_+$//;
 141   return $_;
 142 }
 143
 144 ' ';