prioletters

#!/bin/perl
use strict;

my $prio_vals   = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
length($prio_vals) >= @ARGV+1 || die 'too many groups';

my $symbols     = join '', @ARGV;
my %letterprios = ();
my $cur_prio    = 1;

foreach my $s (@ARGV)
{
    for(my $i = 0; $i < length($s); $i++)
    {
        $letterprios{substr($s, $i, 1)} = substr($prio_vals, $cur_prio, 1);
    }
    $cur_prio++;
}

sub gen_code
{
    my $r = '';
    for(my $i = 0; $i < length($_[0]); $i++)
    {
        $r .= $letterprios{substr($_[0], $i, 1)}||0;
    }
    return join '', reverse sort split(//, $r);
}

my %words_with_prio = ();
while(<STDIN>)
{
    next if /([$symbols]).*\1/ or /[a-zA-Z]/;
    my $s = join '', sort split(//);
    if($s =~ /.*[$symbols]{3,}.*/)
    {
        chomp;
        $words_with_prio{gen_code($_)} = $_;
    }
}

foreach my $c (reverse sort keys %words_with_prio)
{
    print "$words_with_prio{$c}\n";
}