]> git.treefish.org Git - fex.git/blob - htdocs/FAQ/faq.pl
Original release 20160919
[fex.git] / 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 ' ';