modules/list-banned-content.pl

   1 # Copyright (C) 2012  Alex Schroeder <alex@gnu.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify it under
   4 # the terms of the GNU General Public License as published by the Free Software
   5 # Foundation; either version 3 of the License, or (at your option) any later
   6 # version.
   7 #
   8 # This program is distributed in the hope that it will be useful, but WITHOUT
   9 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  10 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along with
  13 # this program. If not, see <http://www.gnu.org/licenses/>.
  14
  15 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/list-banned-content.pl">list-banned-content.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/BannedContent">Index Extension</a></p>';
  16
  17 $Action{'list-banned-content'} = \&DoListBannedContent;
  18
  19 sub DoListBannedContent {
  20   print GetHeader('', T('Banned Content'), '');
  21   my @pages = AllPagesList();
  22   my %url_regexps;
  23   my %text_regexps;
  24   foreach (split(/\n/, GetPageContent($BannedContent))) {
  25     next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
  26     $url_regexps{qr($1)} = $4;
  27   }
  28   foreach (split(/\n/, GetPageContent($BannedRegexps))) {
  29     next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
  30     $text_regexps{qr($1)} = $4;
  31   }
  32   print '<div class="content banned"><p>';
  33   print $BannedContent . ': ' . scalar(keys(%url_regexps)) . $q->br() . "\n";
  34   print $BannedRegexps . ': ' . scalar(keys(%text_regexps)) . $q->br() . "\n";
  35  PAGE: foreach my $id (@pages) {
  36     OpenPage($id);
  37     my @urls = $str =~ /$FullUrlPattern/go;
  38     foreach my $url (@urls) {
  39       foreach my $re (keys %url_regexps) {
  40         if ($url =~ $re) {
  41           print GetPageLink($id) . ': '
  42             . Tss('Rule "%1" matched "%2" on this page.', $re, $url) . ' '
  43               . ($url_regexps{$re}
  44                  ? Ts('Reason: %s.', $url_regexps{$re})
  45                  : T('Reason unknown.')) . $q->br() . "\n";
  46           next PAGE;
  47         }
  48       }
  49     }
  50     foreach my $re (keys %text_regexps) {
  51       if ($Page{text} =~ $re) {
  52         print GetPageLink($id) . ': '
  53           . Tss('Rule "%1" matched on this page.', $re) . ' '
  54             . ($text_regexps{$re}
  55                ? Ts('Reason: %s.', $text_regexps{$re})
  56                : T('Reason unknown.')) . $q->br() . "\n";
  57         next PAGE;
  58       }
  59     }
  60   }
  61   print '</p></div>';
  62   PrintFooter();
  63 }