Difference between revisions of "Favorites/ScoringCode"
From Exalted - Unofficial Wiki
(Making link extractor smarter.) |
m (link fix) |
||
| (2 intermediate revisions by 2 users not shown) | |||
| Line 13: | Line 13: | ||
my $contents="$rootpath/content"; | my $contents="$rootpath/content"; | ||
| − | my $rootfile="$ | + | my $rootfile="$contentsFavorites/[[ScoringCode/Favorites]].txt"; |
my $now = localtime time; | my $now = localtime time; | ||
| 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"; | ||
| Line 83: | Line 83: | ||
if ($test eq $line) | if ($test eq $line) | ||
{ | { | ||
| − | # Check for wikiword links like TheLink at the start of a list | + | # Check for wikiword links like [[TheLink]] at the start of a list |
$test = $line; | $test = $line; | ||
$test =~ s/^\*+\s*([A-Z0-9][\w\/-]+[A-Z0-9][\w\/-]+).*/$1/; | $test =~ s/^\*+\s*([A-Z0-9][\w\/-]+[A-Z0-9][\w\/-]+).*/$1/; | ||
Revision as of 08:06, 5 April 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="$contentsFavorites/[[ScoringCode/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;
}
}