locale/french/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       " Frequently Asked Questions</h1>\n";
  14
  15 if ($faq ne 'local') {
  16   print "<h3>\n";
  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 "<table>\n";
  28
  29 foreach my $faq (@faq) {
  30   open $faq,"$faq.faq" or next;
  31   local $/ = "Q:";
  32   local $_ = <$faq>;
  33   while (<$faq>) {
  34     chomp;
  35     while (/\$([\w_]+)\$/) {
  36       $var = $1;
  37       $env = $ENV{$var} || '';
  38       # s/\$$var\$/<code>$env<\/code>/g;
  39       s/\$$var\$/$env/g;
  40     };
  41     ($q,$a) = split /A:\s*/;
  42     $q =~ s/[\s\n]+$//;
  43     $q =~ s! (/\w[\S]+/[\S]+)! <code>$1</code>!g;
  44     $a =~ s/[\s\n]+$/\n/;
  45     while ($a =~ s/^(\s*)\*/$1<ul>\n$1<li>/m) {
  46       while ($a =~ s/(<li>.*\n\s*)\*/$1<li>/g) {}
  47       $a =~ s:(.*\n)(\s*)(<li>[^\n]+\n):$1$2$3$2</ul>\n:s
  48     }
  49     $a =~ s/\n\n/\n<p>\n/g;
  50     $a =~ s/([^>\n\\])\n/$1<br>\n/g;
  51     $a =~ s/<pre>(.+?)<\/pre>/pre($1)/ges;
  52     $a =~ s/\\\n/\n/g;
  53 #    $a =~ s/^\s*<br>\s*//mg;
  54     $a =~ s/<([^\s<>\@]+\@[\w.-]+)>/<a href="mailto:$1">&lt;$1><\/a>/g;
  55     $a =~ s! (/\w[\S]+/[\S]+)! <code>$1</code>!g;
  56     $a =~ s!(https?://[\w-]+\.[^\s<>]+)!<a href="$1">[$1]</a>!g or
  57     $a =~ s!(https?://[^\s<>]+)!<code>$1</code></a>!g;
  58     push @{$Q{$faq}},$q;
  59     push @{$A{$faq}},$a;
  60   }
  61   close $faq;
  62 }
  63
  64 print "<table>\n";
  65
  66 foreach $s (sections($faq)) {
  67
  68   $c = lc $s;
  69   $s = '' if $s eq 'Local';
  70   $t = '';
  71   $t = $s if $faq eq 'all';
  72
  73   for ($n = 0; $n < scalar(@{$Q{$c}}); $n++) {
  74     printf "<tr><th align=left>%s Q%d:<td> <a href=\"#%s%d\">%s</tr>\n",
  75            $s,$n+1,$t,$n+1,${Q{$c}[$n]};
  76   }
  77 }
  78
  79 print "</table>\n";
  80
  81 foreach $s (sections($faq)) {
  82
  83   $c = lc $s;
  84   $s = '' if $s eq 'Local';
  85   $t = '';
  86   $t = $s if $faq eq 'all';
  87
  88   for ($n = 0; $n < scalar(@{$Q{$c}}); $n++) {
  89     print "<p><hr><p>\n";
  90     print "<table>\n";
  91     printf "<tr><th><a name=\"%s%d\">%s&nbsp;Q%d:</a><td>%s</tr>\n",
  92            $t,$n+1,$s,$n+1,${Q{$c}[$n]};
  93     printf "<tr valign=top><th>%s&nbsp;A%d:<td>\n%s</tr>\n",
  94            $s,$n+1,${A{$c}[$n]};
  95     print "<tr><th>[<a href=\"#top\">Top</a>]<td></tr>\n";
  96     print "</table>\n";
  97   }
  98 }
  99
 100 print "<pre>\n";
 101 print "\n" x 99;
 102 print "</pre>\n";
 103
 104
 105 sub sections {
 106   my $faq = shift;
 107   if ($faq eq 'all') {
 108     return @sections;
 109   } else {
 110     return ucfirst($faq);
 111   }
 112 }
 113
 114 sub pre {
 115   local $_ = shift;
 116   s/<br>//g;
 117   s/\s+$//;
 118   return "<pre>$_</pre>\n";
 119 }