package d::WikiProjectTagging;
use utf8;
use strict;
use Data::Dumper;
use Carp;
use Digest::SHA qw/sha256_base64/;
use AnomieBOT::API;
AnomieBOT::API::load('d::Templates');
AnomieBOT::API::load('d::Redirects');
use vars qw/@ISA/;
@ISA=qw/d::Templates d::Redirects/;
# List of categories containing templates to insert banners after
my %_aftercats=(
'Category:Talk header templates'=>1,
'Category:Non-subject-matter-related article-talk header templates' => 1,
'Category:Article talk header templates'=>1,
'Category:Portal talk header templates'=>1,
'Category:Script talk header templates'=>1,
'Category:Template talk header templates'=>1,
'Category:User talk header templates'=>1,
'Category:Wikipedia talk header templates'=>1,
'Category:Wikipedia GA templates'=>1,
'Category:Wikipedia featured content templates'=>1,
'Category:Wikipedia release version templates'=>1,
'Category:WikiProject banners'=>3,
'Category:WikiProject banners with quality assessment'=>3,
'Category:WikiProject banners without quality assessment'=>3,
);
=pod
=head1 NAME
d::WikiProjectTagging - AnomieBOT decorator for WikiProject tagging
=head1 SYNOPSIS
use AnomieBOT::API;
$api = new AnomieBOT::API('conf.ini', 1);
$api->decorators(qw/d::WikiProjectTagging/);
=head1 DESCRIPTION
C<d::WikiProjectTagging> contains functions for manipulating the WikiProject
banners on a talk page. When "d::WikiProjectTagging" is used as a decorator on
the API object, the following methods are available.
Also, all the methods provided by A<d::Templates> and A<d::Redirects> are
available, as they are used internally.
=head1 CALLBACKS
Several functions in this module take callback functions. In all cases, these
callbacks are called with the following parameters:
=over
=item $banner
Name of the banner.
=item $name
Name of the banner template used in the page.
=item $oname
The original name of the banner template as specified in the wikitext,
including any leading or trailing whitespace.
=item $params
Array reference containing all the banner's parameters.
=item $wikitext
The raw wikitext of the banner.
=item $new
A boolean indicating whether the banner is being added to the page.
=back
In cases where output text is being constructed, the callback may return any
string to replace the original banner wikitext in the output; in all other
cases, it should return undef.
=head1 BANNER DESCRIPTORS
In order to properly assess an article, a descriptor must be loaded for each
banner to be assessed (using the C<WPBconfig> function). The descriptor is a
hash with the following properties:
=over
=item ns
This is a hash mapping assessments to the appropriate "class" and "importance"
parameters. The keys are the assessments as returned by C<WPBassess>, and the
values are 4-element arrays:
=over
=item Z<>0
If defined, the "class" parameter to apply.
=item Z<>1
If defined and the banner already has a "class" parameter, the class will not
be changed if it matches this regular expression. For example, setting
C<qr/\S.*/s> will only apply the class assessment if the banner has no class
parameter or the class parameter is empty.
=item Z<>2
If defined, the "importance" parameter to apply.
=item Z<>3
The same as element index 1 for the "importance" parameter.
=back
=item stubauto
If the banner supports "auto=yes" or the like to indicate that the stub
assessment was automatically applied, specify the parameter and value here.
=item blp
If this is defined and the banner has a pattern matching this regex, "blp=yes"
will be added by C<WPBfixshell>. For example, {{tl|WikiProject Biography}}
would specify C<qr/^\s*living\s*=\s*+(?!(?i)no|n|0|$|¬)/> here.
=item blpo
If this is defined and the banner has a pattern matching this regex, "blpo=yes"
will be added by C<WPBfixshell>. For example, {{tl|WikiProject Biography}}
would specify C<qr/^\s*blpo\s*=\s*+(?!(?i)no|n|0|$|¬)/> here.
=item activepol
If this is defined and the banner has a pattern matching this regex,
"activepol=yes" will be added by C<WPBfixshell>. For example,
{{tl|WikiProject Biography}} would specify
C<qr/^\s*activepol\s*=\s*+(?!(?i)no|n|0|$|¬)/> here.
=item importance
If the banner names its "importance" parameter something other than
"importance" (e.g. "priority"), specify that here.
=item canonicalize
If this is defined, instances of the banner will be renamed to this canonical
name.
=back
For banners using {{tl|WPBannerMeta}}, a typical default configuration may be
obtained from C<WPBMetaConfig>.
=head1 METHODS PROVIDED
=over
=item $api->WPBMetaConfig( $full, %options )
Returns a typical default configuration for a banner using {{tl|WPBannerMeta}}.
C<$full> indictaes whether assessments should be made for the non-article
classes available when QUALITY_SCALE=extended is used. Additional options specify
values for the non-"ns" options in the descriptor.
=cut
sub WPBMetaConfig {
my ($api, $full, %o) = @_;
my %ns=(
stub => [ 'stub', qr/\S.*/s, '', qr/\S.*/s ],
disambig => [ 'disambig', qr/disambig|dab/i, 'NA', qr/na/i ],
0 => [ '', qr/\S.*/s, '', qr/\S.*/s ],
);
if($full){
%ns=(%ns,
redirect => [ 'redirect', qr/redirect|red|redir/i, 'NA', qr/na/i ],
2 => [ 'NA', qr/na/i, 'NA', qr/na/i ], # User
4 => [ 'project', qr/project/i, 'NA', qr/na/i ], # Wikipedia
6 => [ 'image', qr/image/i, 'NA', qr/na/i ], # Image
8 => [ 'NA', qr/na/i, 'NA', qr/na/i ], # MediaWiki
10 => [ 'template', qr/template|templ|temp/i, 'NA', qr/na/i ], # Template
12 => [ 'NA', qr/na/i, 'NA', qr/na/i ], # Help
14 => [ 'category', qr/category|categ|cat/i, 'NA', qr/na/i ], # Category
100 => [ 'portal', qr/portal/i, 'NA', qr/na/i ], # Portal
);
} else {
%ns=(%ns,
redirect => [ undef, undef, undef, undef ],
2 => [ undef, undef, undef, undef ],
4 => [ undef, undef, undef, undef ],
6 => [ undef, undef, undef, undef ],
8 => [ undef, undef, undef, undef ],
10 => [ undef, undef, undef, undef ],
12 => [ undef, undef, undef, undef ],
14 => [ undef, undef, undef, undef ],
100 => [ undef, undef, undef, undef ],
);
}
my %ret=(
'ns' => \%ns,
'stubauto' => exists($o{'stubauto'})?$o{'stubauto'}:'auto=stub',
'importance' => exists($o{'importance'})?$o{'importance'}:'importance',
'blp' => $o{'blp'} // undef,
'blpo' => $o{'blpo'} // undef,
'activepol' => $o{'activepol'} // undef,
'canonicalize' => $o{'canonicalize'} // undef,
);
return \%ret;
}
=pod
=item $api->WPBconfig( $banner => \%descriptor, ... )
Load banner descriptors for use by C<WPBassess> and C<WPBfixshell>. If you need
to unload a descriptor, pass undef.
Note that C<$banner> must be the true name of the banner template (without the
Template: prefix), not a redirect.
=cut
sub WPBconfig {
my ($api, %cfg)=@_;
$api->{'$d::WikiProjectTagging::cfg'}={} unless exists($api->{'$d::WikiProjectTagging::cfg'});
my $t={};
$t=$api->{'$d::WikiProjectTagging::cfg'}{$api->task} if exists($api->{'$d::WikiProjectTagging::cfg'}{$api->task});
while(my ($template, $cfg) = each %cfg){
if(!defined($cfg)){
delete $t->{$template};
} else {
$t->{$template}=$cfg;
}
}
$api->{'$d::WikiProjectTagging::cfg'}{$api->task}=$t;
}
=pod
=item $api->WPBassess( $title )
Return the assessment for the named page. Technically, this only needs to be
called for mainspace pages, as for all other namespaces the assessment is the
namespace number.
Possible assessments are "stub", "redirect", "disambig", 0, 2, 4, 6, 8, 10,
12, 14, and 100.
On API query errors, the error hash from C<< $api->query >> is returned.
=cut
sub WPBassess {
my $api = shift;
my $title = shift;
my $res = $api->query(titles => $title, prop => 'info|categories', inprop => 'subjectid', cllimit => 'max');
return $res if $res->{'code'} ne 'success';
my @p=values %{$res->{'query'}{'pages'}};
if(@p != 1){
return {
code => 'wtferror',
error => 'Expected 1 page result, but got ' . (scalar @p),
};
}
$res=$p[0];
if(exists($res->{'invalid'})){
return {
code => 'invalidtitle',
error => "Title $title is not valid",
};
}
my $ret=$res->{'ns'};
if(($ret&1)!=0){
# Talk page
if(!exists($res->{'subjectid'})){
return {
code => 'pagemissing',
error => "A subject page for ".$res->{'title'}." does not exist",
};
}
return ($ret & ~1) if $ret != 1;
$res = $api->query(pageids => $res->{'subjectid'}, prop => 'info|categories', cllimit => 'max');
return $res if $res->{'code'} ne 'success';
@p=values %{$res->{'query'}{'pages'}};
if(@p != 1){
return {
code => 'wtferror',
error => 'Expected 1 page result, but got ' . (scalar @p),
};
}
$res=$p[0];
$ret=$res->{'ns'};
}
if(exists($res->{'missing'})){
return {
code => 'pagemissing',
error => $res->{'title'}." does not exist",
};
}
if($ret == 0){
if(exists($res->{'redirect'})){
$ret='redirect';
} elsif(grep { $_->{'title'} eq 'Category:All disambiguation pages' } @{$res->{'categories'}}){
$ret='disambig';
} elsif(grep { $_->{'title'}=~/^Category:.* stubs?$/i } @{$res->{'categories'}}){
$ret='stub';
}
}
return $ret;
}
=pod
=item $api->WPBmax( $text, @banners )
=item $api->WPBmin( $text, @banners )
Returns the maximum/minimum class and importance given by the specified
WikiProject banners on this page, or all banners if C<@banners> is empty. If a
descriptor is loaded for any banner, it is used to detect the "importance"
parameter.
Classes considered are: FA, FL, A, GA, B, C, start, stub
Importances considered are: top, high, mid, low
For either assessment, if no banners with the assessment are found the empty
string is returned. On API error, the error object is returned (twice).
=cut
sub WPBmax { return _minmax('max', @_); }
sub WPBmin { return _minmax('min', @_); }
sub _minmax {
my ($which, $api, $text, @banners) = @_;
@banners=('') unless @banners;
my @class=qw(FA FL A GA B C start stub);
my @imp=qw(top high mid low);
my %class=();
my %imp=();
for(my $i=0; $i<@class; $i++){ $class{lc($class[$i])}=$i; }
for(my $i=0; $i<@imp; $i++){ $imp{lc($imp[$i])}=$i; }
my @x=(1000, 1000, -1, -1);
my $err=$api->WPBcheck($text, sub {
my $banner=shift;
my $name=shift;
shift; # oname
my @params=@{shift()};
my $imp='importance';
if(exists($api->{'$d::WikiProjectTagging::cfg'}{$api->task}{'importance'})){
$imp=$api->{'$d::WikiProjectTagging::cfg'}{$api->task}{'importance'};
}
foreach ($api->process_paramlist(@params)){
$_->{'value'}=~s/<!--.*?-->//gs;
$_->{'value'}=~s/^\s+|\s+$//g;
if($_->{'name'} eq 'class' && exists($class{lc($_->{'value'})})){
my $x=$class{lc($_->{'value'})};
$x[0]=$x if $x<$x[0];
$x[2]=$x if $x>$x[2];
}
if($_->{'name'} eq $imp && exists($imp{lc($_->{'value'})})){
my $x=$imp{lc($_->{'value'})};
$x[1]=$x if $x<$x[1];
$x[3]=$x if $x>$x[3];
}
}
return undef;
}, @banners);
return ($err,$err) if ref($err) eq 'HASH';
my @ret=('','');
if($which eq 'max'){
$ret[0]=$class[$x[0]] if($x[0]>=0 && $x[0]<@class);
$ret[1]=$imp[$x[1]] if($x[1]>=0 && $x[1]<@imp);
}
if($which eq 'min'){
$ret[0]=$class[$x[2]] if($x[2]>=0 && $x[2]<@class);
$ret[1]=$imp[$x[3]] if($x[3]>=0 && $x[3]<@imp);
}
return @ret;
}
=pod
=item $api->WPBcheck( $text, @banners )
=item $api->WPBcheck( $text, $callback, @banners )
C<$text> is the page text whose section 0 should be scanned. C<$callback> is a
callback (as defined above) to call for each found banner. The remaining
parameters are the (non-redirect, non-prefixed) names of banners to check.
In a scalar context, returns the number of banners found. In a list context,
returns a 2-element list consisting of the count and the possibly-modified
$text. On error, returns the API error object.
=cut
sub WPBcheck {
my $api=shift;
my $text=shift;
my $func=(ref($_[0]) eq 'CODE') ? shift : undef;
my ($any, %banners);
if($_[0] eq ''){
$any=1;
} else {
$any=0;
%banners=$api->redirects_to_resolved(map "Template:$_", @_);
return (wantarray ? ($banners{''},$banners{''}) : $banners{''}) if exists($banners{''});
}
my ($ct, $outtxt);
if($text=~/^==/){
$ct=0; $outtxt=$text;
} else {
$ct=0;
my ($section0,$section1)=(($text=~/^(.*?)(\n==.*)$/s)?($1,$2):($text,''));
$outtxt=$api->process_templates($section0, sub {
my $banner;
my $name=shift;
my $params=shift;
my $wikitext=shift;
shift; # $data
my $oname=shift;
return undef unless($any || exists($banners{"Template:$name"}));
$ct++;
return undef unless defined($func);
if(exists($banners{"Template:$name"})){
$banner=$banners{"Template:$name"};
} else {
my %map=$api->resolve_redirects("Template:$name");
$banner=$map{"Template:$name"};
}
return undef unless $banner=~s/^Template://;
return $func->($banner, $name, $oname, $params, $wikitext, 0);
}).$section1;
}
return wantarray?($ct,$outtxt):$ct;
}
=pod
=item $api->WPBremove( $text, @banners )
C<$text> is the page text whose section 0 should be scanned, and the remaining
parameters are the (non-redirect, non-prefixed) names of banners to remove.
On error, returns the API error object. In a scalar context, returns the text
with banners removed; in a list context, returns a list with the text removed
as the first element and the removed banners' wikitext as the remaining
elements.
=cut
sub WPBremove {
my $api=shift;
my $text=shift;
my @ret=();
(undef, $text)=$api->WPBcheck($text, sub { push @ret, $_[4]; return ''; }, @_);
return wantarray?($text,@ret):$text;
}
=pod
=item $api->WPBadd( $text, $assessment, $banner, @params )
=item $api->WPBadd( $text, $assessment, $callback, $banner, @params )
Adds the banner to the page, or modifies the existing banner if it is already
present. If C<$assessment> is not undef, the loaded banner descriptor will be
used to assess the banner prior to merging the parameters.
If the banner already exists and no callback is specified, the passed
parameters are merged into the existing banner; if a callback is passed, the
callback may return appropriately-merged banner text, or undef to merge in the
default manner. When the banner does not already exist, the callback is called
with parameters already in place so no merging is needed.
Returns the text with the banner added, or an API error object on error.
=cut
sub WPBadd {
my $api=shift;
my $text=shift;
my $assessment=shift;
my $deffunc=(ref($_[0]) ne 'CODE');
my $func=$deffunc?sub { return undef; }:shift;
my $banner=shift;
my @params=@_;
my $cfg={};
if(exists($api->{'$d::WikiProjectTagging::cfg'}{$api->task}{$banner})){
$cfg=$api->{'$d::WikiProjectTagging::cfg'}{$api->task}{$banner};
}
# Try to adjust an existing banner
my ($ct,$outtxt)=$api->WPBcheck($text, sub {
my $banner=shift;
my $name=shift;
my $oname=shift;
my $params=shift;
my $wikitext=shift;
$params=_assess($cfg, $assessment, $params) if(exists($cfg->{'ns'}) && defined($assessment));
my $ret=$func->($banner, $name, $oname, $params, $wikitext, 0);
return $ret if defined($ret);
my %p=();
foreach ($api->process_paramlist(@$params)){
$p{$_->{'name'}}=$_->{'text'};
}
foreach ($api->process_paramlist(@params)){
$p{$_->{'name'}}=$_->{'text'};
}
return '{{'.$oname.'}}' unless %p;
return '{{'.$oname.'|'.join('|', values %p).'}}';
}, $banner);
return $ct if ref($ct) eq 'HASH';
return $outtxt if $ct>0;
# No existing banner, construct the template now.
my $tmpl;
@params=@{_assess($cfg, $assessment, \@params)} if(exists($cfg->{'ns'}) && defined($assessment));
my ($blp, $blpo, $activepol)=(0,0,0);
if(defined($cfg->{'blp'})){
my $re=$cfg->{'blp'};
$blp=1 if grep(/$re/, @params);
}
if(defined($cfg->{'blpo'})){
my $re=$cfg->{'blpo'};
$blpo=1 if grep(/$re/, @params);
}
if(defined($cfg->{'activepol'})){
my $re=$cfg->{'activepol'};
$activepol=1 if grep(/$re/, @params);
}
my $name=$cfg->{'canonicalize'} // $banner;
$tmpl="{{$name";
$tmpl.='|'.join('|',@params) if @params;
$tmpl.='}}';
if(!$deffunc){
$tmpl=$func->($banner,$name,$name,\@params,$tmpl,1) // $tmpl;
return $text if $tmpl eq '';
}
# First, try to find a banner shell
($ct,$outtxt)=$api->WPBcheck($text, sub {
my $banner=shift;
my $name=shift;
my $oname=shift;
my $params=shift;
my @p_name=();
my @p_num=();
foreach ($api->process_paramlist(@$params)){
if($_->{'name'}=~/^\d+$/){
$_->{'value'}=~s/^\s+|\s+$//g;
push @p_num, $_->{'value'} if $_->{'value'} ne '';
} else {
push @p_name, $_->{'text'};
}
}
if($blp){
push @p_name, 'blp=yes' unless grep(s/^(\s*(?:blp|living)\s*=(?:\s*(?=\S))?).*?(\s*)$/${1}yes$2/s, @p_name);
}
if($blpo){
push @p_name, 'blpo=yes' unless grep(s/^(\s*blpo\s*=(?:\s*(?=\S))?).*?(\s*)$/${1}yes$2/s, @p_name);
}
if($activepol){
push @p_name, 'activepol=yes' unless grep(s/^(\s*activepol\s*=(?:\s*(?=\S))?).*?(\s*)$/${1}yes$2/s, @p_name);
}
push @p_name, "1=\n".join("\n", @p_num)."\n$tmpl\n";
return "{{$oname|".join('|', @p_name)."}}";
}, 'WikiProject banner shell');
return $ct if ref($ct) eq 'HASH';
return $outtxt if $ct>0;
# No banner shell. Check the templates in section 0 to see if there is any
# we should go after. First, look for actual banners.
my $nowiki;
($outtxt,$nowiki)=$api->strip_nowiki($text);
my $outtmpl={};
my $after=$api->process_templates($outtxt, \&_strip_templates, $outtmpl);
$after=~s/^(.*?)(?=\n==|$)//s;
$outtxt=$1;
while(1){
$after=$1.$after if $outtxt=~s/([^\x03]+)$//s;
last unless $outtxt=~s/(\x02[0-9A-Za-z_-]+\x03)$//;
my $tag=$1;
if(!exists($outtmpl->{$tag})){
# Not a template
$after=$tag.$after;
next;
}
my $chk=_chk_template($api, $outtmpl->{$tag}{'name'});
return $chk if ref($chk) eq 'HASH'; # Fail
if(!($chk&2)){
# Not a banner
$after=$tag.$after;
next;
}
# Is a banner! Put the new one just after it
$outtxt.=$tag."\n".$tmpl;
$outtxt.="\n" unless $after=~/^\s*\n/;
$outtxt.=$after;
$outtxt=_unstrip_templates($outtxt, $outtmpl);
$outtxt=$api->replace_nowiki($outtxt, $nowiki);
return $outtxt;
}
# No banner shell, and no other banners either. Just
# pull stuff off the front until we hit content or a
# template we shouldn't go after.
while(1){
$outtxt.=$1 if $after=~s/^((?:\s*<!--.*?-->)*)//s;
last unless $after=~s/^(\s*)(\x02[0-9A-Za-z_-]+\x03)//;
my ($sp,$tag)=($1,$2);
if(!exists($outtmpl->{$tag})){
# Not a template, so put it back and stop looking.
$after=$sp.$tag.$after;
last;
}
my $chk=_chk_template($api, $outtmpl->{$tag}{'name'});
return $chk if ref($chk) eq 'HASH'; # Fail
if($chk){
$outtxt.=$sp.$tag;
next;
}
# It's some other template. End!
$after=$sp.$tag.$after;
last;
}
$outtxt.="\n" if $outtxt ne '';
$outtxt.=$tmpl;
$outtxt.="\n" unless $after=~/^\s*\n/;
$outtxt.=$after;
$outtxt=_unstrip_templates($outtxt, $outtmpl);
$outtxt=$api->replace_nowiki($outtxt, $nowiki);
return $outtxt;
}
# process_templates callback to strip templates and store them in the fourth
# parameter hash
sub _strip_templates {
my ($name, $params, $wikitext, $data) = @_;
return undef if $name=~/^#tag:\s*ref$/is;
$wikitext=_unstrip_templates($wikitext,$data);
my $tmp = $wikitext;
utf8::encode( $tmp ) if utf8::is_utf8( $tmp );
my $tag="\x02".sha256_base64($tmp)."\x03";
$tag=~tr!+/=!-_!d;
$data->{$tag}={ name=>$name, text=>$wikitext };
return $tag;
}
# Undo what _strip_templates did
sub _unstrip_templates {
my $wikitext=shift;
my $templ=shift;
$wikitext=~s!(\x02[a-zA-Z0-9_-]+\x03)! exists($templ->{$1})?$templ->{$1}{'text'}:$1 !gioe;
return $wikitext;
}
# Returns with bit 0 set if the template is in the %_aftercats category, and bit
# 1 set if it's an actual wikiproject banner.
sub _chk_template {
my $api=shift;
my $name=shift;
my $chk = $api->cache->get("\$d::WikiProjectTagging::chk:".$api->task."<<$name>>");
if(!defined($chk)){
my $res=$api->query(
titles => "Template:$name",
prop => 'categories',
cllimit => 'max',
redirects => 1,
);
return $res if $res->{'code'} ne 'success';
my $pg=(values %{$res->{'query'}{'pages'}})[0];
my @c=exists($pg->{'categories'})?@{$pg->{'categories'}}:();
$chk=0;
while(my ($k,$v)=each %_aftercats){
$chk|=$v if grep($k eq $_->{'title'}, @c);
}
$api->cache->set("\$d::WikiProjectTagging::chk:".$api->task."<<$name>>", $chk, 86400);
$pg->{'title'}=~s/^Template://;
$api->cache->set("\$d::WikiProjectTagging::chk:".$api->task."<<$pg->{title}>>", $chk, 86400);
}
return $chk;
}
=pod
=item $api->WPBassessbanners( $text, $assessment, @banners )
C<$text> is the page text whose section 0 should be scanned, and the remaining
parameters are the (non-redirect, non-prefixed) names of banners to assess.
On error, returns the API error object. In a scalar context, returns the text
with banners assessed; in a list context, returns a list with the text as the
first element and the banners' names as the remaining elements.
=cut
sub WPBassessbanners {
my $api=shift;
my $text=shift;
my $assessment=shift;
my @ret=();
(undef, $text)=$api->WPBcheck($text, sub {
my $banner=shift;
my $name=shift;
my $oname=shift;
my $params=shift;
my $wikitext=shift;
if(defined($assessment) && exists($api->{'$d::WikiProjectTagging::cfg'}{$api->task}{$banner})){
my $cfg=$api->{'$d::WikiProjectTagging::cfg'}{$api->task}{$banner};
$params=_assess($cfg, $assessment, $params) if exists($cfg->{'ns'});
}
my $tmpl="{{$oname";
$tmpl.='|'.join('|',@$params) if @$params;
$tmpl.="}}";
return $tmpl;
}, @_);
return wantarray?($text,@ret):$text;
}
sub _assess {
my $cfg=shift;
my $assessment=shift;
my @params=@{shift()};
return \@params if(!exists($cfg->{'ns'}{$assessment}));
my ($class,$classre,$imp,$impre)=@{$cfg->{'ns'}{$assessment}};
my $impname=$cfg->{'importance'} // 'importance';
if(defined($class) && (!defined($classre) || !grep(/^\s*class\s*=\s*$classre\s*$/s, @params))){
push @params, "class=$class" unless(grep(s/^(\s*class\s*=(?:\s*(?=\S))?).*?(\s*)$/$1$class$2/s, @params));
if(defined($cfg->{'stubauto'})){
my $a=$cfg->{'stubauto'};
my $aa=$a; $aa=~s/\s*=.*//;
if($class eq 'stub'){
push @params, $a unless(grep(s/^\s*\Q$aa\E\s*=(?:\s*(?=\S))?.*?(\s*)$/$a/s, @params));
} else {
@params = grep(!/^\s*\Q$aa\E\s*=/, @params);
}
}
}
if($impname ne '' && defined($imp) && (!defined($impre) || !grep(/^\s*\Q$impname\E\s*=\s*$impre\s*$/s, @params))){
push @params, "$impname=$imp" unless(grep(s/^(\s*\Q$impname\E\s*=(?:\s*(?=\S))?).*?(\s*)$/$1$imp$2/s, @params));
}
return \@params;
}
=pod
=item $api->WPBfixshell( $text )
=item $api->WPBfixshell( $text, \@log )
This function fixes up any banner shells in section 0 of C<$text>, and returns
the fixed text.
At the moment, this renumbers the parameters if necessary, adds blp or
activepol if necessary, edits configured banners to remove unneeded
"nested=yes" and canonicalize names.
If the optional C<@log> arrayref is provided, the actions performed will be
added there.
On error, returns the API error object.
=cut
sub WPBfixshell {
my $api=shift;
my $text=shift;
my $log=shift || [];
my $blp=0;
my $blpo=0;
my $activepol=0;
my $did_nested=0;
my $did_canon=0;
(undef,$text)=$api->WPBcheck($text, sub {
my $banner=shift;
my $name=shift;
my $oname=shift;
my @params=@{shift()};
if($banner eq 'WikiProject Biography'){
$blp=1 if grep(/^\s*living\s*=\s*+(?!(?i)no|n|0|$|¬)/, @params);
$blpo=1 if grep(/^\s*blpo\s*=\s*+(?!(?i)no|n|0|$|¬)/, @params);
$activepol=1 if grep(/^\s*activepol\s*=\s*+(?!(?i)no|n|0|$|¬)/, @params);
}
my $ct=@params;
@params=grep $_!~/^\s*nested\s*=/, @params;
if(!$did_nested && $ct!=@params){
$did_nested=1;
push @$log, "remove obsolete 'nested'";
}
if(exists($api->{'$d::WikiProjectTagging::cfg'}{$api->task}{$banner})){
my $cfg=$api->{'$d::WikiProjectTagging::cfg'}{$api->task}{$banner};
if(defined($cfg->{'blp'})){
my $re=$cfg->{'blp'};
$blp=1 if grep(/$re/, @params);
}
if(defined($cfg->{'blpo'})){
my $re=$cfg->{'blpo'};
$blpo=1 if grep(/$re/, @params);
}
if(defined($cfg->{'activepol'})){
my $re=$cfg->{'activepol'};
$activepol=1 if grep(/$re/, @params);
}
if(defined($cfg->{'canonicalize'})){
$name=$cfg->{'canonicalize'};
my $ooname=$oname;
$oname=~s/^(\s*)\S(?:.*\S)?(\s*)$/$1$name$2/s;
if($ooname ne $oname){
push @$log, "canonicalize banner names" unless $did_canon;
$did_canon=1;
}
}
}
my $tmpl="{{$oname";
$tmpl.='|'.join('|',@params) if @params;
$tmpl.="}}";
return $tmpl;
}, '');
return $text if ref($text) eq 'HASH';
my $didblp=0;
(undef,$text)=$api->WPBcheck($text, sub {
my $banner=shift;
my $name=shift;
my $oname=shift;
my $params=shift;
my @p_name=();
my @p_num=();
my $any=0;
foreach ($api->process_paramlist(@$params)){
if($_->{'name'}=~/^\d+$/){
$_->{'value'}=~s/^\s+|\s+$//g;
unless($_->{'value'} eq ''){
push @p_num, $_->{'value'};
$any=1 if $_->{'name'} ne '1';
}
} else {
push @p_name, $_->{'text'};
}
}
unless(@p_num){
push @$log, "remove empty $name";
return '';
}
push @$log, "merging numbered parameters" if $any;
my $x=join('|',@p_name);
if($blp){
$didblp=1;
push @p_name, 'blp=yes' unless grep(s/^(\s*(?:blp|living)\s*=(?:\s*(?=\S))?).*?(\s*)$/${1}yes$2/s, @p_name);
push @$log, "add blp=yes" unless $x eq join('|',@p_name);
} else {
@p_name=grep($_!~/^\s*(blp|living)\s*=/, @p_name);
push @$log, "remove unneeded blp/living" unless $x eq join('|',@p_name);
}
$x=join('|',@p_name);
if($blpo){
$didblp=1;
push @p_name, 'blpo=yes' unless grep(s/^(\s*blpo\s*=(?:\s*(?=\S))?).*?(\s*)$/${1}yes$2/s, @p_name);
push @$log, "add blpo=yes" unless $x eq join('|',@p_name);
} else {
@p_name=grep($_!~/^\s*blpo\s*=/, @p_name);
push @$log, "remove unneeded blpo" unless $x eq join('|',@p_name);
}
$x=join('|',@p_name);
if($activepol){
push @p_name, 'activepol=yes' unless grep(s/^(\s*activepol\s*=(?:\s*(?=\S))?).*?(\s*)$/${1}yes$2/s, @p_name);
push @$log, "add activepol=yes" unless $x eq join('|',@p_name);
} else {
@p_name=grep($_!~/^\s*activepol\s*=/, @p_name);
push @$log, "remove unneeded activepol" unless $x eq join('|',@p_name);
}
my $p_num=join("\n", @p_num);
push @p_name, "1=\n$p_num\n";
return "{{$oname|".join('|', @p_name)."}}";
}, 'WikiProject banner shell');
return $text if ref($text) eq 'HASH';
if($didblp){
(undef,$text)=$api->WPBcheck($text, sub {
push @$log, "remove redundant {{blp}}";
return '';
}, qw(Blp));
return $text if ref($text) eq 'HASH';
}
return $text;
}
1;
=pod
=back
=head1 COPYRIGHT
Copyright 2008–2013 Anomie
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
