forked from github/kensanata.oddmuse
69 lines
2.3 KiB
Perl
69 lines
2.3 KiB
Perl
# Copyright (C) 2012–2015 Alex Schroeder <alex@gnu.org>
|
||
#
|
||
# This program is free software; you can redistribute it and/or modify it under
|
||
# the terms of the GNU General Public License as published by the Free Software
|
||
# Foundation; either version 3 of the License, or (at your option) any later
|
||
# version.
|
||
#
|
||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||
#
|
||
# You should have received a copy of the GNU General Public License along with
|
||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
use strict;
|
||
use v5.10;
|
||
|
||
AddModuleDescription('list-banned-content.pl');
|
||
|
||
our ($q, %Action, %Page, $BannedContent, $BannedRegexps, $FullUrlPattern);
|
||
|
||
$Action{'list-banned-content'} = \&DoListBannedContent;
|
||
|
||
sub DoListBannedContent {
|
||
print GetHeader('', T('Banned Content'), '');
|
||
my @pages = AllPagesList();
|
||
my %url_regexps;
|
||
my %text_regexps;
|
||
foreach (split(/\n/, GetPageContent($BannedContent))) {
|
||
next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
|
||
$url_regexps{qr($1)} = $4;
|
||
}
|
||
foreach (split(/\n/, GetPageContent($BannedRegexps))) {
|
||
next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
|
||
$text_regexps{qr($1)} = $4;
|
||
}
|
||
print '<div class="content banned"><p>';
|
||
print $BannedContent . ': ' . scalar(keys(%url_regexps)) . $q->br() . "\n";
|
||
print $BannedRegexps . ': ' . scalar(keys(%text_regexps)) . $q->br() . "\n";
|
||
PAGE: foreach my $id (@pages) {
|
||
OpenPage($id);
|
||
my @urls = $Page{text} =~ /$FullUrlPattern/g;
|
||
foreach my $url (@urls) {
|
||
foreach my $re (keys %url_regexps) {
|
||
if ($url =~ $re) {
|
||
print GetPageLink($id) . ': '
|
||
. Tss('Rule "%1" matched "%2" on this page.', $re, $url) . ' '
|
||
. ($url_regexps{$re}
|
||
? Ts('Reason: %s.', $url_regexps{$re})
|
||
: T('Reason unknown.')) . $q->br() . "\n";
|
||
next PAGE;
|
||
}
|
||
}
|
||
}
|
||
foreach my $re (keys %text_regexps) {
|
||
if ($Page{text} =~ $re) {
|
||
print GetPageLink($id) . ': '
|
||
. Tss('Rule "%1" matched on this page.', $re) . ' '
|
||
. ($text_regexps{$re}
|
||
? Ts('Reason: %s.', $text_regexps{$re})
|
||
: T('Reason unknown.')) . $q->br() . "\n";
|
||
next PAGE;
|
||
}
|
||
}
|
||
}
|
||
print '</p></div>';
|
||
PrintFooter();
|
||
}
|