[SPOILER] Perl 'Easy' Quiz of the Week #2005-1

Luke Triantafyllidis <[email protected]> Tue, 25 Jan 2005 10:53:37 +1100
Newsgroups gmane.comp.lang.perl.qotw.discuss
Message-ID <[email protected]>
Well, umm..this is my first post to this list, so hopefully I don't 
break anything.

My solution wasn't too fantastic, but it works. I load every prefix into 
a hash key, and the value of each key is an array of suffixes.

#!/usr/bin/perl -w

use strict;

my ($in, $out) = @ARGV;
my %prefixes;

open(IN, '<', $in) || die $!;
open(OUT, '>', $out) || die $!;

while(<IN>)
{
    chomp(my $line = $_);
    if($line =~ /^\w+\.[A-Z]$/)
    {
        my ($prefix, $suffix) = split(/\./, $line);
        $prefixes{$prefix} = () if(!$prefixes{$prefix});
        push @{$prefixes{$prefix}}, $suffix;
    }
}

for my $pref (sort keys %prefixes)
{
   
    push @{$prefixes{$pref}}, 'M' if(!search('M', @{$prefixes{$pref}}));
    print OUT map{"$pref.$_\n";}sort @{$prefixes{$pref}}
}

close(IN);
close(OUT);

sub search
{
    my ($f, @arr) = @_;
    map{return 1 if /^$f$/}@arr;
    return 0;
}