Difference between revisions of "Favorites/ScoringCode"
From Exalted - Unofficial Wiki
(Making link extractor smarter.) |
|||
Line 76: | Line 76: | ||
{ | { | ||
my ($line) = @_; | my ($line) = @_; | ||
+ | return "" if !($line =~ m/^\*/); | ||
chomp $line; | chomp $line; | ||
my $test = $line; | my $test = $line; | ||
− | $test =~ s/^\*+\s* | + | # 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; | ||
} | } | ||
Revision as of 19:50, 17 February 2007
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 (reverse sort { $a <=> $b } 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; } }