Musical Names

#!/usr/bin/perl -w

use strict;

use Parse::MediaWikiDump;
use Text::MediawikiFormat as => 'wiki2html';
use Time::Piece;
use Unicode::Normalize;

no warnings 'utf8';

# Get a list of musicals
my @musicals_tmp = category_members('Broadway musicals',500);

# Remove non-alphas from musicals
my %musicals;
my %hash_musicals;
foreach my $musical (@musicals_tmp)
{
    #print "$musical\n";
    $musical =~ s/[^A-Za-z ]//g;
    $musicals{lc $musical} = 1;
    $hash_musicals{word2num($musical)} = lc $musical;
}
#die;

# Read in famous names
my @names;
my %last_to_first;
open FILE, 'FamousNames.txt' or die $!;
while (<FILE>)
{
    chomp;
    my $name = lc $_;
    my $score = 100;
    if ($name =~ /^(.*)\t(.*)$/) {$name = $1;$score = $2;}
    #next unless $score >= 90;
    my $firstname; my $lastname;
    if ($name =~ /^([^ ]+) ([^ ]+)$/) {$firstname = $1; $lastname = $2;}
    next unless $firstname;
    push(@names,"$firstname $lastname");
    push(@{$last_to_first{$lastname}},$firstname);
}
close FILE;

# Go through the names and pull out anyone with the same first name as a musical
my @musical_names;
foreach my $n (@names)
{
    my ($fn, $ln) = split(/ /,$n);
    push(@musical_names,$n) if $musicals{$fn};
}

foreach my $fullname (@musical_names)
{
    my ($fn, $ln) = split(/ /,$fullname);
    #print " $fn\n";
    # Find all others with the same last name
    my $last_people_ref = $last_to_first{$ln};
    # Check if any of these people have a first name that anagrams to a musical
    foreach my $new_fn (@$last_people_ref)
    {
        next if $fn eq $new_fn;
        #print "  $new_fn\n";
        if ($hash_musicals{word2num($new_fn)} && $hash_musicals{word2num($new_fn)} ne $new_fn)
        {
            print "$fn and $new_fn $ln => " . $hash_musicals{word2num($new_fn)} . "\n";
        }
    }
}


######
# SUBS
######

sub category_members
{
    my ($category,$NUM) = @_;
    $NUM = 500 unless $NUM;
    my %wiki;

    # Rather than parsing this every time, it is MUCH better to store and retrieve.
    my $text_file = $category;
    $text_file =~ s/[^A-Za-z _]//g;
    $text_file =~ s/ /_/g;
    $text_file .= ".txt";

    if (-e $text_file)
    {
        my @ret;
        open MYFILE, $text_file or die $!;
        while (<MYFILE>)
        {
            chomp;
            push(@ret,$_);
        }
        return @ret;
    }
    else
    {
        # This takes a LONG TIME (about an hour or more)
        my $xmlfile = "enwiki-latest-pages-articles.xml";
        my $pages = Parse::MediaWikiDump::Pages->new($xmlfile);

        my @category_members;

        # Go through the XML and pull out interesting entries.
        my $ctr = 0;
        while(defined(my $page = $pages->next) && $ctr < $NUM)
        {
            #main namespace only
            next unless $page->namespace eq '';

            # Exclude redirects
            next if defined($page->redirect);

            # Categories
            my $c = $page->categories;

            # Only take musicals
            next unless (grep {/$category/} @$c);

            # If we've gotten this far we can proceed
            my $title = $page->title;
            $title = remove_diacritics($title);
            if ($title =~ /^(.*) \([^\)]+\)$/) {$title = $1;}

            push(@category_members,$title);
            $ctr++;
        }

        # Add this to a text file to pull up later
        open OUTFILE, ">$text_file" or die $!;
        foreach my $c (@category_members) {print OUTFILE "$c\n";}
        close OUTFILE;
        return @category_members;
    }
}

# Remove diacritics (from a title)
sub remove_diacritics
{
   my $w = NFD(shift);
   $w =~ s/\pM//g;
   return $w;
}

sub word2num
{
    # Given a word, turn it into an order-independent hash
    # Convert the word to ALL CAPS
    my $w = uc shift;
    # Remove any non-alphas
    $w =~ s/[^A-Z]//g;
    my %convert = qw(A 2 B 3 C 5 D 7 E 11 F 13 G 17 H 19 I 23 J 29 K 31 L 37 M 41 N 43 O 47 P 53 Q 59 R 61 S 67 T 71 U 73 V 79 W 83 X 89 Y 97 Z 101);
    my $val = 1;
    foreach my $l (split(//,$w))
    {
        next unless $convert{$l};
        $val *= $convert{$l};
    }
    return $val;
}