#!/usr/bin/perl

#####################################################################
#
#  SORT_EMAIL v0.1                             Last Update: 2022.6.18
#
#  This perl script sorts a list of email addresses by domain and
#  by mailbox. Written by Zsolt N Perry (zsnp@juno.com).
#  This Perl script was tested with TinyPerl 5.8 under Windows XP.
#  This file was downloaded from http://www.wzsn.net/perl
#
#               THIS ENTIRE SOURCE CODE IS FREEWARE.
#  If you want to incorporate it or parts of it into your program,
#  just copy and paste whatever you need! There is no need to ask
#  for permission. This software is distributed "AS IS." There is
#  no warranty of any kind. The author will not be held liable for
#  any loss resulting from the use or misuse of this software.
#
#####################################################################

use 5.004;
use strict;
use warnings;
$| = 1;

my @EMAIL = qw(random34@cox.net chessmasterq@gmail.com rejoice925@gmail.com zeroEmx@juno.com soxLic22@aol.com allemanstr@irs.gov DrLarryT@xvtgb.edu GabrielHalf@state.al.us RonKriss289@gmail.com allentom@ssa.gov gtroempire@hotmail.com Zendris37@bellsouth.net );
$EMAIL[0] .= ' (my email)';

Dump('in original order', @EMAIL);
@EMAIL = sort @EMAIL;
Dump('sorted by Larry, the lazy programmer', @EMAIL);
SortBy('mailbox');
SortBy('domain');
exit;

##################################################
#
# Sort list of emails by mailbox or domain.
#
# Usage: SoryBy(ORDER)
#
sub SortBy
{
  my $ORDER = defined $_[0] ? uc($_[0]) : '';
  my $DISPLAY_HEADING = lc("sorted by $ORDER");
  if ($ORDER eq 'MAILBOX')   { $ORDER = 0; }
  elsif ($ORDER eq 'DOMAIN') { $ORDER = 1; }
  else { print "\nERROR:\tThe SortBy() function must be used in the following manner:\n\tSortBy('mailbox'); or SortBy('domain');\n\totherwise you'll get this error message. Have a nice day!\n"; exit; }

  # First, we create an array called @INDEX which
  # will contain a list of string-and-pointer pairs.
  my @INDEX;
  my $NUMBER_OF_EMAILS = @EMAIL;
  for (my $i = 0; $i < $NUMBER_OF_EMAILS; $i++)
  {
    my $E = Trim($EMAIL[$i]);
    my $P = index($E, '@');
    if ($P < 0) { print "\nERROR:\tMissing character \@ in <$E>\n\tYou know, this doesn't look like a valid email address.\n"; exit; }
    $E = uc($E);

    # Grab either the domain or the mailbox portion of the email
    $E = $ORDER ? substr($E, $P+1) : substr($E, 0, $P);

    # Save this string along with a pointer that points back to this entry
    push(@INDEX, "$E $i");
  }

  # The @INDEX array already contains either a list of domains or
  # a list of mailbox strings all uppercase, and here we just sort them:
  @INDEX = sort @INDEX;

  # Now, we will take the pointers which are found at the end of
  # each sorted string. And we create a new list of email addresses
  # using these sorted pointers.
  my @NEW;
  for (my $i = 0; $i < $NUMBER_OF_EMAILS; $i++)
  {
    my $S = $INDEX[$i];
    my $X = substr($S, rindex($S, ' ') + 1);
    $NEW[$i] = $EMAIL[$X];
  }
  
  # Finally, we display the list.
  Dump($DISPLAY_HEADING, @NEW);
}
##################################################
#
# Displays the value of @EMAIL array as a list.
# Usage: Dump(LABEL, ARRAY)
#
sub Dump
{
  CLS();
  my $FINISH_THE_SENTENCE = shift;
  print "\n  ZSOLT's EMAIL SORTER";
  print "\n\n  These are the emails $FINISH_THE_SENTENCE:\n";
  my $CENTER_ALIGN = (index($FINISH_THE_SENTENCE, 'domain') >= 0) ? 1 : 0;
  my $i = 1;
  foreach (@_)
  {
    print "\n", PadLeft($i, 7, 'x'), '.';
    print ($CENTER_ALIGN ? PadLeft($_, 16, '@') : "\t$_");
    $i++;
  }

  print "\n\n", '-' x 15, '< PRESS ENTER >', '-' x 40;
  scalar <STDIN>;
  return;
}
##################################################
#
# Adds spaces to the left of a string.
# Usage: STRING = PadLeft(STRING, MAX_LENGTH, FROM_CHAR)
#
sub PadLeft
{
  my ($S, $N, $C) = @_;
  my $P = index($S, $C);
  $N -= ($P < 0) ? length($S) : $P;
  return ($N > 0) ? ' ' x $N . $S : $S;
}
##################################################
# Clears the terminal window.
#
sub CLS
{
  my $OS = uc($^O);
  if (index($OS, 'LINUX') >= 0) { print "\x1Bc\x1B[0m\x1B[3J\x1B[H\x1B[2J"; return; }
  if (index($OS,  'DOS' ) >= 0) { system('COMMAND.COM /C CLS'); return; }
  if (index($OS, 'MSWIN') >= 0) { system('CLS'); return; }
  print "\x1B[3J";
}
##################################################
#                                       v2019.8.25
# Removes whitespace from before and after STRING.
# Whitespace is here defined as any byte whose
# ASCII value is less than 33. That includes
# tabs, esc, null, vertical tab, new lines, etc.
# Usage: STRING = Trim(STRING)
#
sub Trim
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  my $P = 0;
  while ($P <= $L && vec($_[0], $P++, 8) < 33) {}
  for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {}
  substr($_[0], $P, $L - $P + 2)
}
##################################################