Favorites/ScoringCode - Revision history

Conversion script: link fix

2010-04-06T01:15:59Z

link fix

Conversion script: link fix

2010-04-06T00:35:44Z

link fix

Conversion script: link fix

2010-04-05T08:06:42Z

link fix

Conversion script: link fix

2010-04-03T09:03:00Z

link fix

Newacct: *

2010-02-17T01:08:11Z

New page

This is the Perl code used to calculate the [[Favorites]] list. It assumes the existence of <tt>*.txt</tt> 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.

<pre>
#!/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;
}
}
</pre>

Wordman: Making link extractor smarter.

2007-02-17T19:50:27Z

Making link extractor smarter.

Wordman: *

2007-02-11T01:29:21Z

← Older revision	Revision as of 01:15, 6 April 2010
(No difference)

@@ Line 13: / Line 13: @@
 my $contents="$rootpath/content";
-my $rootfile="$contentsFavorites/[[ScoringCode/Favorites]].txt";
+my $rootfile="$contents/Favorites.txt";
 my $now = localtime time;

@@ Line 13: / Line 13: @@
 my $contents="$rootpath/content";
-my $rootfile="$contents/Favorites.txt";
+my $rootfile="$contentsFavorites/[[ScoringCode/Favorites]].txt";
 my $now = localtime time;
@@ Line 45: / Line 45: @@
 # Dump results
-foreach my $count (reverse sort { $a <=> $b } keys %groupres)
+foreach my $count (sort { $b <=> $a } keys %groupres)
+{
    print ":'''Favorite of $count users:'''\n";
@@ Line 83: / Line 83: @@
    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 =~ s/^\*+\s*([A-Z0-9][\w\/-]+[A-Z0-9][\w\/-]+).*/$1/;

@@ Line 76: / Line 76: @@
+{
    my ($line) = @_;
    chomp $line;
    my $test = $line;
-   $test =~ s/^\*+\s*(\[\[)?([\w\/-]+).*/$2/;
+  # Check for explicit links like [[TheLink|a label for the link]] or [[TheLink]] at the start of a list
-   return $line eq $test ? "" : $test;
+   $test =~ s/^\*+\s*\[\[([\w\/-]+).*/$1/;
+}