The problem with goblins is that they always come in hordes. This reply inspired me to see if I could take on a horde of goblins, and a slew of other possible scenarios. This is definitely brutal and ugly.

#!/usr/bin/perl

use strict;
use warnings;

my @emails = (
    'foo@barcom',             'longontheleft@foo.com',
    'foo@longontheright.com', 'equalonbothsides@equalonbothsides',
    'almostequal@almostequa', 'a.horde.of.goblins@under.the.floorboard
+s.com',
    'goblins@under.the.floorboards.com'
);

my $MAXLENGTH = 16;
my $NUMDOTS   = 3;

my %emails;
foreach my $email (@emails) {
    $emails{$email}{'length'} = length($email);

    if ( $emails{$email}{'length'} <= $MAXLENGTH ) {
        print "No need to shorten $email\n";
        next;
    }
    ( $emails{$email}{'left'}, $emails{$email}{'right'} ) =
      split( '@', $email );

    if (   ( ( $NUMDOTS + length( $emails{$email}{'right'} ) ) > ($MAX
+LENGTH) )
        && ( ( $NUMDOTS + length( $emails{$email}{'left'} ) ) > ($MAXL
+ENGTH) ) )
    {
        print "Shorten both sides\n";

        # Shorten the left side
        substr(
            $emails{$email}{'left'},
            $MAXLENGTH - ( $MAXLENGTH / 2 ) - $NUMDOTS - 1,
            length( $emails{$email}{'left'} )
          )
          = '.' x $NUMDOTS;

        # Shorten the right side
        substr(
            $emails{$email}{'right'},
            $MAXLENGTH - ( $MAXLENGTH / 2 ) - $NUMDOTS - 1,
            length( $emails{$email}{'right'} )
          )
          = '.' x $NUMDOTS;
    }
    elsif (

        (
            length( $emails{$email}{'left'} ) -
            length( $emails{$email}{'right'} )
        ) > $NUMDOTS
      )
    {
        print "Shortening left side\n";
        substr(
            $emails{$email}{'left'},
            $MAXLENGTH - length( $emails{$email}{'right'} ) - $NUMDOTS
+ - 1,
            length( $emails{$email}{'left'} )
          )
          = '.' x $NUMDOTS;
    }
    else {
        print "Shortening right side\n";
        substr(
            $emails{$email}{'right'},
            $MAXLENGTH - length( $emails{$email}{'left'} ) - $NUMDOTS 
+- 1,
            length( $emails{$email}{'right'} )
          )
          = '.' x $NUMDOTS;
    }

    $emails{$email}{'short'} =
      join( '@', $emails{$email}{'left'}, $emails{$email}{'right'} );

    print "Shortened version ", $emails{$email}{'short'}, " is ",
      length( $emails{$email}{'short'} ), " characters long.\n";
}

1;
__END__

No need to shorten foo@barcom
Shortening left side
Shortened version longo...@foo.com is 16 characters long.
Shortening right side
Shortened version foo@longonthe... is 16 characters long.
Shorten both sides
Shortened version equa...@equa... is 15 characters long.
Shortening right side
Shortened version almostequal@a... is 16 characters long.
Shorten both sides
Shortened version a.ho...@unde... is 15 characters long.
Shortening right side
Shortened version goblins@under... is 16 characters long.

[download]

In reply to Re^2: Shorten email address by redhotpenguin
in thread Shorten email address by redhotpenguin

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.