Difference between revisions of "Favorites/ScoringCode"

From Exalted - Unofficial Wiki
Jump to: navigation, search
m
 
m (link fix)
Line 13: Line 13:
 
my $contents="$rootpath/content";
 
my $contents="$rootpath/content";
  
my $rootfile="$contents/Favorites.txt";
+
my $rootfile="$contents[[/Favorites]].txt";
  
 
my $now = localtime time;
 
my $now = localtime time;
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 09:03, 3 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="$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;
  }
}