my @emails = qw/bob@a.com
    adam@cobra.com
    charles!adam@cobra.com
    ralph@beer.alpha.com
    bob@cobra.com
    rick@ignore.net.au
    fletcher@magma.com
    ballot@alpha.com.au
    biglug@magma.com
    matt@dc.com.au
    demo@beachfront.com
    media@ocular.com.au
    never@ocular.com.au/;

print join("\n",@emails) . "\n\n";

@emails2 = sort by_email @emails;

print join("\n",@emails2);

sub by_email {
    # If they're the same, return 0
    if ($a eq $b) { return 0 }
    
    # Split the two addresses into names and domains
    ($aname,$adomain) = split(/@/,$a);
    ($bname,$bdomain) = split(/@/,$b);
    
    # If the domains are the same, just compare the names
    if ($adomain eq $bdomain) {
        if ($aname gt $bname) { return 1 }
        else { return -1 }
        # No need to handle eq because its handled at the start of the sub
    }
    
    # If the domains are different, we have to sort them
    else {
        # Split the domains into arrays at the periods
        @aparts = split(/\./,$adomain);
        @bparts = split(/\./,$bdomain);
        
        #Make the arrays equal length
        while ($#aparts < $#bparts) { unshift(@aparts,'') }
        while ($#aparts > $#bparts) { unshift(@bparts,'') }

        #loop backwards, comparing the parts as we go
        for ($i = $#aparts; $i >= 0; $i--) {
            return 1 if ($aparts[$i] gt $bparts[$i]);
            return -1 if ($aparts[$i] lt $bparts[$i]);
        }
    }
    
    # If we somehow get all the way through, send back a 0
    # You might prefer to uncomment:
    # die("Sort by_email failed to find a comparisson. Panic.");
    return 0;
}