<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
use strict;
use HTML::TreeBuilder;
use Unicode::Normalize;
use Text::Unidecode;

my @keywords=("Pommel horse","Parallel bars","All","Vault","Horizontal","Floor",
              "Beam","Uneven bars","ATC","Argentina","Athletics","Judo","Athletics","Boxing",
              "Rowing","Weightlifling","Weightlifting","Canoe/Kayak Flatwater","Cycling Track",
              "Shooting","Wrestling","Heat","Final","Final A","Duet Technical Routine",
              "Taekwondo","Archery","Sailing","Canoe/Kayak Slalom","Modern pentathlon",
              "Did not advance","Head Coach","SCG","Swimming","Badminton","Table Tennis",
              "Badminton","Gymnastics","artistic","Handball","Spanish Olympic Committee",
              "road","team","single","star","laser","tornado","Rings","Dressage",
              "Eliminated First Round","Canoeing","Equestrian","Trampoline","Hockey",
              "Cycling","Road","Diving","Fencing","Tennis","Run","Total","Ghana",
              "Silver Medal","Official Website","It","Windsurfer","Heat","Qualifying Round",
              "Single/double","Mixed Laser", "final", "Bbc Olympics",
              "Great Britain At The","British Olympic Association A","their Team Gb Pages",
              "Bbc Olympics News","coverage","China At The","Malta Olympic Committee",
              "Prince Of Monaco","Dutch Sailing Results","Turkish Olympic Committee Web Site",
              "Us Olympic Association","Montevideo.com","Womans","Double Trap","Women",
              "Relay","Men","Doublesingle","Tunisia","Eliminated First Round", "Eliminated", "First Round",
              "Treshan Mcdonald", "Croatian Olympic Committee", "Mountain Bike", "Womens", "Olimpio Cipriano",
              "Dressage", "Tied With Australia", "Water Polo", "Final"
);

#Note: Treshan Mcdonald was eliminated by a Chinese athlete but accidentally appears in China's team

my $year="2004";
my $mainreffile="Olympics-ParticipatingCountries.txt";
my $countries;
open (MAINREF,"$mainreffile") || die "Can't open the main reference file";
while (&lt;MAINREF&gt;) {
    my ($year,$country,$url)=split("\t",$_);
    if (defined ($country)) {
        $countries-&gt;{$country}=$url;
    }
}
close (MAINREF);

#Set a specific country to debug
#undef $countries;
#$countries-&gt;{China}=1;
my $master={};
my $ext=".html";
my $outfile="Olympics-RawOutput.txt";
open (OUTPUT,"&gt;$outfile") || die "Can't open the outfile";
foreach my $country (sort(keys(%$countries))) {
    my $filename=$year."/".$year.$country.$ext;
    my $tree=HTML::TreeBuilder-&gt;new_from_file($filename);
    my @unclean=$tree-&gt;look_down("_tag","li");
    my $startmarker=0;
    my $endmarker=0;
    for (my $i=0;$i&lt;=$#unclean;$i++){
        if ($unclean[$i]-&gt;as_text=~/^\d.*/) {
            $startmarker=$i;
        }   
        if ($unclean[$i]-&gt;as_text eq "Article") {
            $endmarker=$i;
        }   
    }
    $startmarker++;
    my $length=$endmarker-$startmarker;
    my @partclean=splice(@unclean,$startmarker,$length);
    undef my @fullclean;
    undef my @moreclean;
    foreach (@partclean) {
        #bottom li but not further para
        my @belowelements=$_-&gt;look_down("_tag","li");
        my $basedepth=0;
        undef my @baseobjects;
        if (defined $belowelements[0]) {
            foreach (@belowelements) {
                if ($basedepth==0) {
                    $basedepth=$_-&gt;depth;
                }
                if ($basedepth &lt;= $_-&gt;depth) {
                    $basedepth=$_-&gt;depth;
                }
            }
            foreach (@belowelements) {
                if ($_-&gt;depth==$basedepth) {
                    push (@baseobjects,$_);
                }
            }
        }
        else {
            push (@baseobjects,$_);
        }
        push (@moreclean,@baseobjects);
    }
    foreach (@moreclean) {
        #â€” and - forward remove
        my $text=$_-&gt;as_text;
        $text=NFKD($text);
        $text=unidecode($text);
        $text=~s/-.*$//;
        $text=~s/–.*$//;
        $text=~s/â€”.*$//;
        $text=~s/â€“.*$//;
        $text=~s/â†’.*$//;
        $text=~s/:\s{0,2}(\d|\+).*//;
        $text=~s/^\s{1,2}//;
        $text=~s/\s{1,2}$//;
        $text=~s/^.*\d\)://;
        $text=~s/^\s{1,2}//;
        $text=~s/\s{1,2}$//;
        $text=~s/^\^.*$//;
        $text=~s/^Round of \d{1,2}.*//;
        $text=~s/^Quarterfinal.*//;
        $text=~s/^Quarter.*//;
        $text=~s/^Semifinal.*//;
        $text=~s/^Semi.*//;
        $text=~s/^First .*//i;
        $text=~s/^Second .*//i;
        $text=~s/^Race .*//i;
        $text=~s/^Final.*//;
        $text=~s/^Bronze .*//;
        $text=~s/: Bronze .*//;
        $text=~s/^Silver .*//;
        $text=~s/^Gold .*//;
        $text=~s/^Round \d{1,2}.*//;
        $text=~s/^Preliminary .*//;
        $text=~s/^Preliminaries.*//;
        $text=~s/^Elimination .*//;
        $text=~s/^Repechage .*//i;
        $text=~s/^Repchange .*//i;
        $text=~s/^Repechages.*//i;
        $text=~s/^defeated .*//i;
        $text=~s/^lost .*//i;
        $text=~s/ lost .*//i;
        $text=~s/^died to .*//i;
        $text=~s/^the .*//i;
        $text=~s/did not .*//i;
        $text=~s/was defeated .*//i;
        $text=~s/he was a .*//i;
        $text=~s/was a .*//i;
        $text=~s/won his .*//i;
        $text=~s/placed .*//i;
        $text=~s/won the .*//i;
        $text=~s/won a .*//i;
        $text=~s/bye to .*//i;
        $text=~s/finished .*//i;
        $text=~s/\sWomans//i;
        $text=~s/\sRegent//i;
        $text=~s/Montevideocom//i;
        $text=~s/^Team.*://;
        $text=~s/^Deputy.*://;
        $text=~s/^Interpreter.*://;
        $text=~s/^President.*://;
        $text=~s/^Secretary.*://;
        $text=~s/^Coach.*://;
        $text=~s/^Coaches.*://;
        $text=~s/^Players.*://;
        $text=~s/^Manager.*://;
        $text=~s/^Chief Medical Officer.*://;
        $text=~s/.*Coach.*://;
        $text=~s/^Women://i;
        $text=~s/^Swimmers://i;
        $text=~s/^Captain://i;
        $text=~s/^Chef De Mission://i;
        $text=~s/^Project Manager://i;
        $text=~s/^Chief Physiotherapist://i;
        $text=~s/^Women('| ).*//i;
        $text=~s/^Men('| ).*//i;
        $text=~s/^Run .*//;
        $text=~s/^Team Roster.*//;
        $text=~s/^Prelims.*//;
        $text=~s/^Sports.*//;
        $text=~s/^Classification.*//;
        $text=~s/^Cyprus in .*//;
        $text=~s/.*NOC$//;
        $text=~s/^JR\.//;
        $text=~s/^\d*//;
        $text=~s/\(.*//;
        $text=~s/(,| )and /,/;
        $text=~s/\&amp;/,/;
        $text=~s/;/,/g;
        $text=~s/in qualifying$//;
        $text=~s/riding .*//;
        $text=~s/: Women.*//i;
        $text=~s/: show.*//i;
        $text=~s/: single.*//i;
        $text=~s/Raced In .*$//i;
        $text=~s/Didn't .*$//i;
        $text=~s/Finishing .*$//i;
        $text=~s/Failed .*$//i;
        $text=~s/Although .*$//i;
        $text=~s/Best Throw .*$//i;
        $text=~s/Qualified .*$//i;
        $text=~s/Veteran Cyclist .*$//i;
        $text=~s/Who Four Years .*$//i;
        $text=~s/Earned .*$//i;
        $text=~s/Came Close .*$//i;
        $text=~s/She Seemed .*$//i;
        $text=~s/On August .*$//i;
        $text=~s/Only Competitor .*$//i;
        $text=~s/Repechage .*$//i;
        $text=~s/Gold Medal .*$//i; 
        $text=~s/Silver Medal .*$//i;
        $text=~s/This Year.*$//i;
        $text=~s/Best Ever .*$//i;
        $text=~s/Who Double .*$//i;
        $text=~s/Defend .*$//i;
        $text=~s/Convinced It .*$//i;
        $text=~s/Returns To .*$//i;
        $text=~s/Medal Favourite .*$//i;
        $text=~s/Men's .*$//i;
        $text=~s/Women's .*$//i;
        $text=~s/Fourth .*$//i;
        $text=~s/Convinced .*$//i;
        $text=~s/Returns To .*$//i;
        $text=~s/Medal Favourite .*$//i;
        $text=~s/defeated in round of//;
        $text=~s/ I{1,3}$//i;
        $text=~s/^\s{1,2}//;
        $text=~s/\s{1,2}$//;
        $text=~s/\d.*$//;
        $text=~s/\sa\s.*$//;
        $text=~s/\://g;
        $text=~s/\'//g;
        $text=~s/\.//g;
        $text=~s/\=//g;
        $text=~s/\&gt;\&gt;/a/g;
        $text=~s/\///g;
        $text=~s/\s*$//;
        $text=~s/\sa$//;
        $text=~s/^\s*//;
        $text=~s/\sV$//;
        $text=&amp;purify($text);
        if ($text eq "") {$text=undef;}
        if (defined $text) {
            if ($text=~/,/) {
                my @texts=split(",",$text);
                foreach (@texts) {
                    s/^\s{1,2}//;
                    s/\s{1,2}$//;
                    if ($_ ne "") {push (@fullclean,$_)};
                }
            }
            else {
                push (@fullclean,$text)
            }
        }
    }
    #now remove keywords
    undef my @reallyclean;
    foreach my $name (@fullclean) {
        my $flag=0;
        foreach my $word (@keywords) {
            if ($name=~/^$word( |$)/i) {
                $flag=1;
            }
        }
        if (!$flag) {
            push @reallyclean,$name;    
        }
    }
    #Load up the master hash
    foreach (@reallyclean) {
        my $currentname=$_;
        $currentname=ucfirst($currentname);
        my @temp=split(" ",$_);
        if (scalar(@temp)&lt;2) {next;} #drop single words - they are an error
        if (defined ($master-&gt;{$country}-&gt;{$currentname})) {$master-&gt;{$country}-&gt;{$currentname}++;}
        else {$master-&gt;{$country}-&gt;{$currentname}=1;}
    }
}
foreach my $country (sort {$a cmp $b}(keys (%$master))){
    foreach my $name (sort {$a cmp $b} (keys %{$master-&gt;{$country}})) {
        print OUTPUT $country."\t".$name."\t".$master-&gt;{$country}-&gt;{$name}."\n";
    }
}
print "Done";
close (OUTPUT);

sub purify {
    my $name=shift(@_);
    $name=~s/A\!/A/g;
    $name=~s/A ([a-z])/A$1/g;
    $name=~s/A1\/2/A/g;
    $name=~s/A1\/4/A/g;
    $name=~s/A3\/4/A/g;
    $name=~s/A\|/A/g;
    $name=~s/A\+/A/g;
    $name=~s/A\$\?/A/g;
    $name=~s/A\&lt;\&lt;/A/g;
    $name=~s/Ac\//C/g;
    my @nameparts=split(" ",$name);
    if (scalar(@nameparts) &lt; 1) {
        $name=lc($name);
        $name=ucfirst($name);
        return $name;
    }
    else {
        my $revisedname=undef;
        foreach (@nameparts) {
            $revisedname=$revisedname.ucfirst(lc($_));
            $revisedname=$revisedname." ";
        }
    $revisedname=~s/\s$//;
    return $revisedname;
    }
}</pre></body></html>