Difference between revisions of "Favorites/ScoringCode"
From Exalted - Unofficial Wiki
(Making link extractor smarter.) |
m |
||
| Line 45: | Line 45: | ||
# Dump results | # Dump results | ||
| − | foreach my $count ( | + | foreach my $count (sort { $b <=> $a } keys %groupres) |
{ | { | ||
print ":'''Favorite of $count users:'''\n"; | print ":'''Favorite of $count users:'''\n"; | ||
Revision as of 01:08, 17 February 2010
This is the Perl code used to calculate the Favorites list. It assumes the existence of *.txt files containing the wiki text of the root favorites page and the pages to which it links. Creating such files is left as an exercise for the reader.
#!/usr/bin/perl
#Author: Wordman
use Time::Local;
use strict;
my %seen;
my $rootpath='/path/to/files';
my $contents="$rootpath/content";
my $rootfile="$contents/Favorites.txt";
my $now = localtime time;
print "Run begins: $now\n";
my @links;
get_bullet_links($rootfile,\@links);
my %results;
foreach my $link (@links)
{
my $path = "$contents/$link.txt";
my %favs;
count_favorites($path,\%favs);
foreach my $fav (keys %favs)
{
$results{$fav} ||= 0;
$results{$fav} += 1;
print "Counting vote from $link for $fav\n";
}
}
# Now build an inverted result map
my %groupres;
foreach my $fav (keys %results)
{
my $count = $results{$fav};
$groupres{$count}{$fav} = '';
}
# Dump results
foreach my $count (sort { $b <=> $a } keys %groupres)
{
print ":'''Favorite of $count users:'''\n";
my $list = $groupres{$count};
foreach my $fav (sort keys %$list)
{
print "::[[$fav]]\n";
}
}
sub get_bullet_links
{
my ($path,$list) = @_;
if (open(DAT, $path))
{
my @existing=<DAT>;
close(DAT);
foreach my $line (@existing)
{
my $link = extract_bullet_link($line);
next if !$link;
push(@$list,$link);
}
}
}
sub extract_bullet_link
{
my ($line) = @_;
return "" if !($line =~ m/^\*/);
chomp $line;
my $test = $line;
# Check for explicit links like [[TheLink|a label for the link]] or [[TheLink]] at the start of a list
$test =~ s/^\*+\s*\[\[([\w\/-]+).*/$1/;
if ($test eq $line)
{
# Check for wikiword links like TheLink at the start of a list
$test = $line;
$test =~ s/^\*+\s*([A-Z0-9][\w\/-]+[A-Z0-9][\w\/-]+).*/$1/;
}
my $link = $line eq $test ? "" : $test;
return $link;
}
sub count_favorites
{
my ($path,$favs) = @_;
my @links;
get_bullet_links($path,\@links);
# Count each link only once
foreach my $link (@links)
{
$favs->{$link} = 1;
}
}