locale/french/htdocs/FAQ/faq.pl

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