#!/usr/bin/perl
# This script is released under the GFDL license, see
# http://en.wikipedia.org/w/index.php?title=User:HBC_AIV_helperbot/source&action=history
# for a full list of contributors
use strict;
use warnings;
### Configuration ###
my $read_rate = 30;
my $write_rate = 15;
my (%pages_to_watch) =
(
'Wikipedia:Administrator intervention against vandalism' => $read_rate,
'Wikipedia:Administrator intervention against vandalism/TB2' => $read_rate,
'Wikipedia:Usernames for administrator attention' => $read_rate,
'Wikipedia:Usernames for administrator attention/Bot' => $read_rate,
'Wikipedia:Usernames for administrator attention/Holding pen' => $read_rate,
);
# Pattern to match examples used in the instructions
my $example_pattern = qr/(?:IP ?address|username)/i;
my @desired_parameters = qw(
RemoveBlocked MergeDuplicates AutoMark FixInstructions AutoBacklog
);
### End Configuration ###
use DateTime;
use DateTime::Format::Duration;
use MediaWiki;
use Net::Netmask;
use POSIX qw(strftime);
use Time::Local;
use URI::Escape;
my $version_number = '2.0.25';
my $VERSION = "HBC AIV helperbot v$version_number";
my %special_ips;
my %notable_cats;
my $instructions = '';
local $SIG{'__WARN__'} = \&mywarn;
⁃
open(PASS,'password'); # A file with only the password, no carriage return
sysread(PASS, my $password, -s(PASS)); # No password in source code.
close(PASS);
open(USER,’username'); # A file with only the username, no carriage return
sysread(USER, my $username, -s(USER)); #
close(USER);
my $c = MediaWiki->new;
$c->setup
({
'bot' => {'user' => $username,'pass' => $password},
'wiki' => {'host' => 'en.wikipedia.org','path' => 'w', 'ssl' => 1}
}) || die "Failed to log in\n";
my $whoami = $c->user();
warn "$whoami v$version_number connected.\n";
# The program runs in this loop which handles a queue of jobs.
my(@job_list);
my $timing = 0;
add_job([\&get_ip_list,$c],0);
add_job([\&get_instructions,$c],0);
add_job([\&check_login,$c],600);
foreach my $page (keys %pages_to_watch)
{
add_job([\&check_page,$c,$page],$timing);
$timing += 5;
}
while (1) # Infinite loop, a serpent biting it's own tail.
{
sleep(1); # Important in all infinite loops to keep it calm
my (@kept_jobs); # A place to put jobs not ready to run yet
while (my $job = shift(@job_list)) # Go through each job pending
{
my($r_job , $timing) = @{$job};
if ($timing < time()) # If it is time to run it then run it
{
if (ref($r_job) eq 'ARRAY') # Callback style, reference an array with a sub followed by paramaters
{
my $cmd = shift(@{$r_job});
&{$cmd}(@{$r_job});
}
elsif (ref($r_job) eq 'CODE') # Otherwise just the reference to the sub
{
&{$r_job};
}
}
else # If it is not time yet, save it for later
{
push(@kept_jobs , $job)
}
}
push (@job_list , @kept_jobs); # Keep jobs that are still pending
}
###################
### SUBROUTINES ###
###################
sub add_job # Command to add a job to the queue
{
my ($r_job , $timing) = @_;
push (@job_list , [$r_job , (time()+$timing)]);
}
sub check_instructions {
my ($c, $page, $content) = @_;
unless ($content =~ m/\Q$instructions\E/s) {
add_job([\&fix_instructions,$c,$page],0);
return 0;
}
return 1;
}
sub check_login {
my ($c) = @_;
my $html = $c->{ua}->get("https://en.wikipedia.org/wiki/User:$whoami")->content();
warn "Checking login... $whoami v$version_number still connected.\n";
if ($html =~ m|\"wgUserName\":null|) {
warn "Login check failed, logging back in!\n";
delete $c->{'logged_in'};
$c->login;
}
add_job([\&check_login,$c],600);
}
sub check_page # Read the page and gather usernames, give each use a check_user job on the queue
{ # Then add Check_page to the queue scheduled for $read_rate seconds
my ($c,$page) = @_;
# Get page, read only
my $content = $c->get($page, 'r')->{'content'};
unless ($content && $content =~ m|\{\{((?:no)?adminbacklog)\}\}\s*<\!-- (?:HBC AIV helperbot )?v([\d.]+) ((?:\w+=\S+\s+)+)-->|i)
{
warn "Could not find parameter string, not doing anything: $page\n";
add_job([\&check_page,$c,$page],$pages_to_watch{$page});
return;
}
my($ab_current, $active_version, $parameters) = ($1,$2,$3);
unless (check_version($active_version)) {
warn "Current version $version_number not allowed by active version $active_version on $page! Will check again in 2 minutes.\n";
add_job([\&check_page,$c,$page],120); # Schedule myself 2 minutes later
return;
}
my $params = parse_parameters($parameters);
add_job([\&check_page,$c,$page],$pages_to_watch{$page});
($params->{'AutoBacklog'} = '') if ($params->{'AddLimit'} <= $params->{'RemoveLimit'});
if ($params->{'FixInstructions'} eq 'on') {
return unless check_instructions($c,$page,$content);
}
my @content = split("\n",$content); # Split into lines
my $report_count = 0;
my (%user_count, @IP_comments_needed, $merge_called, $in_comment);
foreach my $line (@content)
{
my $bare_line;
($in_comment,$bare_line, undef) = comment_handler($line, $in_comment);
next if ($in_comment && ($line eq $bare_line));
($bare_line =~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|\s*(.+?)\s*}}/i) || next(); # Go to next line if there is not a vandal template on this one.
my $user = $2; # Extract username from template
my $user2;
if ($user =~ m/^((?:1|user)=)/i) {
$user2 = $user;
$user =~ s/^$1//i;
}
$report_count++;
$user_count{$user}++;
if (($user_count{$user} > 1) && !($merge_called) && ($params->{'MergeDuplicates'} eq 'on'))
{
warn "Calling merge because of $user on $page\n";
add_job([\&merge_duplicate_reports,$c,$page],0);
$merge_called = 1;
}
if ($params->{'RemoveBlocked'} eq 'on') {
add_job([\&check_user,$c,$user,$page],0); # Queue a check_user job for the user to run ASAP
if ($user2) {
add_job([\&check_user,$c,$user2,$page],0);
}
}
my(@cats) = check_cats($user);
if (scalar(@cats))
{
$special_ips{$user} = 'User is in the '.((scalar(@cats) > 1) ? ('categories') : ('category')).': ';
foreach (@cats)
{
$_ = '[[:Category:'.$_.'|'.$_.']]'
}
$special_ips{$user} .= join(', ',@cats);
$special_ips{$user} .= '.';
}
if ($params->{'AutoMark'} eq 'on' && !$merge_called)
{
if ($line !~ m|<\!-- Marked -->|)
{
foreach my $mask (keys(%special_ips))
{
if ($mask =~ m|^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:/\d{1,2})?$| && $user =~ m|^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$|) {
if (Net::Netmask->new($mask)->match($user))
{
push (@IP_comments_needed, [\&comment_special_IP,$c,$page,$user,$mask]);
last; # only match one mask
}
} else {
if ($mask eq $user) {
push (@IP_comments_needed, [\&comment_special_IP,$c,$page,$user,$mask]);
last; # only match one mask
}
}
}
}
}
}
foreach my $ra_param (@IP_comments_needed)
{
add_job([@{$ra_param},$report_count],0);
}
if ($params->{'AutoBacklog'} eq 'on' && !$merge_called)
{
add_job([\&set_backlog,$c,$page,$report_count,$params->{'AddLimit'},$params->{'RemoveLimit'}],0)
if ((($report_count >= $params->{'AddLimit'}) && ($ab_current eq 'noadminbacklog')) ||
(($report_count <= $params->{'RemoveLimit'}) && ($ab_current eq 'adminbacklog')));
}
return;
}
sub check_user # Determine if the user is blocked, if so gather information about the block
{ # and shedule a remove_name job with all the information passed along
my ($c,$user,$page) = @_;
my $url = $c->{index}.'?title=Special:Ipblocklist&ip='.uri_escape($user);
my $data = $c->{ua}->get($url)->content(); # Get blocklist info for user
if ($data =~ m|TablePager mw-blocklist">|) # If the user is currently blocked
{
# Get name of blocking admin
($data =~ m'TablePager_col_ipb_by"><a href="/wiki/User:(.*?)" (title|class)=') || ($data =~ m'\d{2}, <a href="/w/index\.php\?title=User:(.*?)&'); #"
my $blocker = uri_unescape($1);
# Get expiry time of block, starting time of block, and calculate total time
my $duration;
if ($data =~ m|TablePager_col_ipb_expiry">(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})|) # Match expiry time if one exists
{
my $expiry = DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>'UTC');
$data =~ ( m|TablePager_col_ipb_timestamp">(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})|); # Match starting time
my $block_time = DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>'UTC');
$duration = timeconv($expiry, $block_time); # Pretty print the difference via timeconv (see below)
}
elsif($data =~ m/never|infinite|no expiry set/) # If there is no expiry and the word 'infinite' is found
{
$duration = 'indef'; # Set to indef
}
# Get block type flags
my(@flags);
(push(@flags,'AO')) if ($data =~ m|anon\. only|); # Match anon only
(push(@flags,'ACB')) if ($data =~ m|account creation blocked|); # Match account creation blocked
(push(@flags,'ABD')) if ($data =~ m|autoblock disabled|); # Match autoblock disabled
my $block_type = ''; # Build empty string
# If any flag exists build a flag string.
$block_type = '[[User:HBC AIV helperbot/Legend|('.join(' ',@flags).')]]' if (scalar(@flags));
add_job([\&remove_name,$c,$user,$blocker,$duration,$block_type,$page],0); # Queue a remove_name job to run ASAP
}
}
sub check_version {
my ($active_version) = @_;
my @active_parts = split(/\./, $active_version);
my @my_parts = split(/\./, $version_number);
return 0 if scalar(@active_parts) > scalar(@my_parts); # should never happen
foreach (@active_parts) {
my $check_part = shift(@my_parts);
last if $check_part > $_;
next if $_ <= $check_part;
return 0;
}
return 1;
}
sub comment_handler {
my ($line, $in_comment) = @_;
my ($comment_starts, $comment_ends, $remainder) = (0,0,'');
if ($in_comment) {
# check if an opened comment ends in this line
if ($line =~ m|-->|) {
$line =~ s|(.*?-->)||;
$in_comment = 0;
$comment_ends = 1;
$remainder = $1;
}
}
# remove any self-contained comments
$line =~ s|<!--.*?-->||g;
if ($line =~ s|<!--.*||) {
$in_comment = 1;
$comment_starts = 1;
}
return (wantarray) ? ($in_comment, $line, $remainder) :
$in_comment;
}
sub comment_special_IP
{
my($c,$page_name,$user,$mask,$report_count) = @_;
my $page = $c->get($page_name, 'rw'); # Get page read/write
return unless $page->{'content'};
my(@content) = split("\n",$page->{'content'}); # Split into lines
my (@new_content, $in_comment); # Place to put replacement content
foreach my $line (@content) {
$in_comment = comment_handler($line, $in_comment);
if (($line =~ m|\Q$user\E|) && ($line =~ m/{{((?:ip)?vandal|userlinks|user-uaa)/i))
{
return if ($line =~ m|<\!-- Marked -->|);
$line .= ' -->' if $in_comment;
$line .= ' <!-- Marked -->'."\n:*'''Note''': $special_ips{$mask} ~~~~";
$line .= ' <!-- ' if $in_comment;
}
push(@new_content,$line);
}
my $tally;
$tally = 'Empty.' if ($report_count == 0);
$tally ||= ($report_count.' report'.(($report_count > 1) ? ('s remaining.') : (' remaining.')));
$page->{'content'} = join("\n",@new_content);
$page->{'summary'} = $tally." Commenting on $user: $special_ips{$mask}";
$page->save();
warn "$user matched $mask, marked as: $special_ips{$mask}\n";
return 1;
}
sub fix_instructions {
my ($c, $page_name) = @_;
my $page = $c->get($page_name, 'rw');
my $content = $page->{'content'};
return unless $content;
if ($content =~ m|===\s*User-reported\s*===\n|s) {
$content =~ s|<!-- HagermanBot Auto-Unsigned -->|RE-ADD-HAGERMAN|;
my @content = split("\n", $content);
my (@reports_to_move, $in_comment, $report_count, $msg);
foreach my $line (@content) {
my ($bare_line,$remainder);
($in_comment,$bare_line,$remainder) = comment_handler($line, $in_comment);
if ($line =~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|\s*(?!$example_pattern)/i) {
push(@reports_to_move, $line) if $in_comment;
$report_count++;
} elsif ($remainder =~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|\s*(?!$example_pattern)/i) {
$remainder =~ s/-->//;
push(@reports_to_move, $remainder);
}
}
if ($content =~ m|===\s*User-reported\s*===\s+<!--|s) {
$content =~ s:(===\s*User-reported\s*===\s+)<!--.*?(-->|$):$1$instructions:s;
$msg = '';
} else {
$content =~ s|(===\s*User-reported\s*===\n)|$1$instructions\n|s;
$msg = ' Old instructions not found, please check page for problems.';
}
my $remaining_text;
if ($report_count) {
$remaining_text = ($report_count > 1) ? "$report_count reports remaining." : "$report_count report remaining.";
} else {
$remaining_text = "Empty.";
}
if (@reports_to_move) {
my $reports_moved = scalar(@reports_to_move);
if ($reports_moved > 50) {
$page->{'summary'} = "$remaining_text Reset [[WP:AIV/I|instruction block]], WARNING: tried to move more than 50 reports, aborting - check history for lost reports.$msg";
} else {
foreach my $report (@reports_to_move) {
if ($report =~ m|RE-ADD-HAGERMAN|) {
$report =~ s|RE-ADD-HAGERMAN|<!-- HagermanBot Auto-Unsigned -->|;
$report =~ s|~~~~||;
} else {
$report =~ s|~~~~|~~~~ <small><sup>(Original signature lost - report made inside comment)</sup></small>|;
}
$content .= "$report\n";
}
$page->{'summary'} = "$remaining_text Reset [[WP:AIV/I|instruction block]], $reports_moved report(s) moved to end of page.$msg";
}
} else {
$page->{'summary'} = "$remaining_text Reset [[WP:AIV/I|instruction block]].$msg";
}
$content =~ s|RE-ADD-HAGERMAN|<!-- HagermanBot Auto-Unsigned -->|;
$page->{'content'} = $content;
$page->save();
warn "Reset instruction block: $page_name\n";
} else {
warn "FATAL ERROR: User-reported header not found on $page_name! Sleeping 2 minutes.\n";
unless ($content =~ m|<!-- HBC AIV helperbot WARNING -->|) {
$content .= "<!-- HBC AIV helperbot WARNING -->\n";
$page->{'summary'} = 'WARNING: User-reported header not found!';
$page->{'content'} = $content;
$page->save();
}
sleep(120);
return;
}
}
sub get_instructions {
my ($c) = @_;
warn "Fetching instructions...\n";
my $content = $c->get('Wikipedia:Administrator intervention against vandalism/instructions', 'r')->content();
unless ($content) {
warn "failed to load page - will try again in 2 minutes.\n";
add_job([\&get_instructions,$c],120);
return;
}
$instructions = ''; # start with a clean slate
my $keep = 0;
foreach my $line (split("\n",$content)) {
if (!$keep && $line =~ m/^<!-- HBC AIV helperbot BEGIN INSTRUCTIONS -->$/) {
$keep = 1;
next;
} elsif ($keep && $line =~ m/^<!-- HBC AIV helperbot END INSTRUCTIONS -->$/) {
$keep = 0;
}
next unless $keep;
$instructions .= "$line\n";
}
chomp($instructions);
warn "Done, will check again in 30 minutes.\n";
add_job([\&get_instructions,$c],1800);
}
sub get_ip_list
{
my($c) = @_;
warn "Fetching special IP list...\n";
my $ip_table = $c->get('User:HBC AIV helperbot/Special IPs','r')->content();
unless ($ip_table) {
warn "Failed to load page - will try again in 2 minutes.\n";
add_job([\&get_ip_list,$c],120);
return;
}
%special_ips = (); # Clear any old list
foreach my $line (split("\n",$ip_table))
{
if ($line =~ m|^\* \[\[:Category:(.*?)\]\]$|)
{
$notable_cats{$1} = 1;
next;
}
next unless ($line =~ m|^;(.*?):(.*)$|);
my ($ip, $comment) = ($1, $2);
next unless ($ip =~ m|^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:/\d{1,2})?$|);
$special_ips{$ip} = "This IP matches the mask ($ip) in my [[User:HBC AIV helperbot/Special IPs|special IP list]] which is marked as: \"$comment\"";
}
warn "Done, will check again in 10 minutes.\n";
add_job([\&get_ip_list,$c],600); # Run myself in 10 minutes
}
sub merge_duplicate_reports
{
my ($c, $page_name) = @_;
my $page = $c->get($page_name, 'rw'); # Get page read/write
return unless $page->{'content'};
my(@content) = split("\n",$page->{'content'}); # Split into lines
my (@new_content, %user_table, $report_count, $in_comment);
while (scalar(@content)) {
my $line = shift(@content);
my $bare_line;
($in_comment,$bare_line,undef) = comment_handler($line, $in_comment);
next if $line eq "\n";
if (($in_comment && ($line eq $bare_line)) || $bare_line !~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|\s*(.*?)\s*}}/i)
{
push(@new_content,$line); next;
}
my $user = $2;
if ($user =~ m/^((?:1|user)=)/i) {
$user =~ s/^$1//i;
}
if ($user)
{
unless ($user_table{$user})
{
push(@new_content,$line);
$user_table{$user} = \$new_content[scalar(@new_content)-1];
while ((scalar(@content)) && !($content[0] =~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|/i) && !($content[0] =~ m|<\!--|))
{
my $comment = shift(@content);
$in_comment = comment_handler($comment, $in_comment);
${$user_table{$user}} .= "\n$comment"
}
$report_count++;
}
else
{
$line =~ s|^\*||;
$line =~ s/{{((?:ip)?vandal|userlinks|user-uaa)\|\s*(.*?)\s*}}//i;
${$user_table{$user}} .= "\n:*$line <small><sup>(Moved by bot)</sup></small>";
}
}
}
my $tally;
$tally = 'Empty.' if ($report_count == 0);
$tally ||= ($report_count.' report'.(($report_count > 1) ? ('s remaining.') : (' remaining.')));
$page->{'content'} = join("\n",@new_content);
$page->{'summary'} = "$tally Duplicate entries merged";
$page->save();
warn "Duplicates merged: $page_name\n";
}
sub parse_parameters {
my ($parameters) = @_;
my %result;
foreach my $item (split(/\s+/, $parameters)) {
my ($key, $value) = split(/=/, $item);
$result{$key} = lc($value);
}
foreach (@desired_parameters) {
$result{$_} ||= 'off';
}
if ($result{'AutoBacklog'} eq 'on') {
$result{'AddLimit'} ||= 0;
$result{'RemoveLimit'} ||= 0;
}
return \%result;
}
sub remove_name
{
my ($c,$user,$blocker,$duration,$block_type,$page_name) = @_;
my $page = $c->get($page_name, 'rw'); # Get page read/write
return unless $page->{'content'};
my($ips_left,$users_left) = ('0','0'); # Start these with 0 instead of undef
my(@content) = split("\n",$page->{'content'}); # Split into lines
my (@new_content, $found, $lines_skipped, $in_comment);
while (scalar(@content)) {
my $line = shift(@content);
my ($bare_line,$remainder);
($in_comment,$bare_line,$remainder) = comment_handler($line, $in_comment);
unless (!$in_comment && $line =~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|\s*(?:1=|user=)?\Q$user\E\s*}}/i)
{
push(@new_content,$line);
next if ($in_comment && ($line eq $bare_line));
if($bare_line =~ m/{{IPvandal\|/i)
{
$ips_left++;
}
if($bare_line =~ m/{{(vandal|userlinks|user-uaa)\|/i)
{
$users_left++;
}
}
else
{
$found = 1;
push(@new_content,$remainder) if $remainder;
while ((scalar(@content)) && !($content[0] =~ m/{{((?:ip)?vandal|userlinks|user-uaa)\|/i) && !($content[0] =~ m|^<\!--|) && !($content[0] =~ m/^=/))
{
my $removed = shift(@content);
if (length($removed) > 0) {
$lines_skipped++;
$in_comment = comment_handler($removed, $in_comment);
}
}
}
}
$page->{'content'} = join("\n",@new_content);
return unless($found); # Cancel if could not find the entry attempting to be removed.
return unless($page->{'content'}); # Cancel if result would blank the page.
my $length = ((defined($duration)) ? (' '.$duration) : (' '));
$length = ' indef ' if (defined($duration) && $duration eq 'indef');
my $tally;
if ($ips_left || $users_left)
{
$tally = join(' & ',
(
(($ips_left) ? ($ips_left.' IP'.(($ips_left > 1) ? ('s') : (''))) : ()),
(($users_left) ? ($users_left.' user'.(($users_left > 1) ? ('s') : (''))) : ()),
)).' left.';
}
else
{
$tally = 'Empty.'
}
my $skipped = (($lines_skipped) ? (" $lines_skipped comment(s) removed.") : (''));
$page->{'summary'} = $tally.' rm [[Special:Contributions/'.$user.'|'.$user.']] (blocked'.$length.'by [[User:'.$blocker.'|'.$blocker.']] '.$block_type.'). '.$skipped;
$page->save();
warn "rm '$user': $page_name\n";
sleep($write_rate);
}
sub set_backlog
{
my ($c, $page_name, $report_count,$ab_add,$ab_remove) = @_;
$report_count ||= '0';
my $page = $c->get($page_name, 'rw'); # Get page read/write
return unless $page->{'content'};
my(@content) = split("\n",$page->{'content'}); # Split into lines
my(@new_content); # Place to put replacement content
foreach my $line (@content)
{
if ($line =~ m|^\{\{(?:no)?adminbacklog\}\}|i)
{
my $tally;
$tally = 'Empty.' if ($report_count == 0);
$tally ||= ($report_count.' report'.(($report_count > 1) ? ('s remaining.') : (' remaining.')));
if ($report_count >= $ab_add)
{
warn "Backlog added to: $page_name\n";
$page->{'summary'} = ($tally.' Noticeboard is backlogged.');
$line =~ s|^\{\{noadminbacklog|\{\{adminbacklog|i;
push (@new_content,$line);
}
elsif ($report_count <= $ab_remove)
{
warn "Backlog removed from: $page_name\n";
$page->{'summary'} = ($tally.' Noticeboard is no longer backlogged.');
$line =~ s|^\{\{adminbacklog|\{\{noadminbacklog|i;
push (@new_content,$line);
}
}
else
{
push(@new_content,$line);
}
}
$page->{'content'} = join("\n",@new_content);
return unless($page->{'content'});
$page->save();
}
sub check_cats
{
my ($user) = @_;
my (@response);
my $url = "http://en.wikipedia.org/w/api.php?action=query&prop=categories&titles=User%20talk:".uri_escape($user)."&format=json";
my $data = $c->{ua}->get($url)->content();
while ($data =~ m|{"ns":14,"[^"]*":"Category:(.*?)"\}|g) # " A comment with a quote to fix a bug in syntax highlighting
{
if ($notable_cats{$1})
{
push(@response, $1);
}
}
return @response;
}
sub timeconv {
my($expiry, $block_time) = @_;
my $duration = $expiry - $block_time;
my $formatter = DateTime::Format::Duration->new(
pattern => '%Y years, %m months, %e days, %H hours, %M minutes, %S seconds',
normalize => 1,
base => $block_time,
);
my %normalized = $formatter->normalize($duration);
my @periods = ('years','months','days','hours','minutes','seconds');
my $output;
if ($normalized{'minutes'} || $normalized{'seconds'}) {
$output = sprintf('until %s %s ', $expiry->ymd, $expiry->hms);
} else {
foreach (@periods) {
$output .= sprintf('%s %s, ', $normalized{$_}, $_) if $normalized{$_};
if ($normalized{$_} == 1) {
my $singular = $_;
$singular =~ s/s$//;
$output =~ s/$_/$singular/;
}
}
$output =~ s/, $/ /;
# special cases
if ($output eq '1 day, 7 hours ') {
$output = '31 hours ';
} elsif ($output eq '4 days, 3 hours ') {
$output = '99 hours ';
} elsif ($output eq '4 days, 4 hours ') {
$output = '100 hours ';
}
}
return $output;
}
sub mywarn {
my ($msg) = @_;
if ($^O eq 'MSWin32')
{
CORE::warn($msg);
}
else
{
CORE::warn('['.strftime('%F %T UTC',gmtime()).'] '.$msg);
}
}
