var list:array[0..99] of string;
    numItems:integer;
    cnt:integer;

function killsubstr(sub:string; var s:string):integer;

var    p:integer;
begin;
	p:=pos(s,sub);
	if p <> 0 then delete(s,p,length(sub));
	killsubstr:=p; 
	
end;

procedure killsubstrat(sub:string; var s:string; p:integer);

begin;
	delete(s,p,length(sub));
end;
 
function killcaps(s:string):string;
var p:integer;
    newval:string;	
begin;
	newval:='';
	for p:=1 to length(s) do 
	  if NOT ((ord(s[p]) >= ord('A')) and (ord(s[p]) <= ord('Z')))
then
	    newval:=newval+s[p];
	killcaps:=newval;
end;

function characterpresentafter(ps:integer; s:string; ch:char):boolean;
var p:integer;
    found:boolean;
begin;

	found:=false;
	for p:=ps+1 to length(s) do if s[ps] =  ch then found:=true;
	characterpresentafter:=found;
end;

function killbrackets(s:string):string;
var p:integer;
    newval:string;
    marker:char;	
begin;
	newval:='';
	p:=1;
	repeat
		if (s[p] = '[') or (s[p] = '(') or (s[p] = '<') or (s[p] =
'{') then begin;
		case s[p] of
			'[':marker:=']';
			'(':marker:=')';
			'<':marker:='>';
			'{':marker:='}';
		end;
		if characterpresentafter(p,s,marker) then begin;
		repeat
			inc(p);
			if (s[p] = '@') or (s[p] = '.') then
                        newval:=newval+s[p];
		until (s[p]=marker) or (p > length(s));  end;
		end;
		inc(p);
		if (p <= length(s)) then newval:=newval+s[p];
	until (p > length(s));

	killbrackets:=newval;
end;

function killinvalidchars(s:string):string;
var p:integer;
    newval:string;
begin;
	newval:='';
	for p:=1 to length(s) do if
          NOT (s[p] in ['-','*',' ','_','!']) then begin;
            newval:=newval+s[p];
          end;
	killinvalidchars:=newval;
end;

function isinvalid(ch:char):boolean;
begin;
 isInvalid:=(ch in ['-','*',' ','_','!']);
end;

function isInvalidCharAt(s:string; p:integer):boolean;
begin;
 isInvalidCharAt:=(isInvalid(s[p]) or (p < 1) or (p > length(s)));
end;

function filterAt(s:string):string;
var retval:string;
    teststring:string;
	p:integer;
	gotone:boolean;
begin;
	teststring:=s;
	retval:=s;
	for p:=1 to length(s) do teststring[p]:=upcase(teststring[p]);
	repeat
		gotone:=false;
	        p:=pos(teststring,'AT');
		if p = 0 then p:=pos(teststring,'DOT') else begin;
                  gotone:=true;
		  if isInvalidCharAt(retval,p-1) and
isInvalidCharAt(retval,p+2) then begin;
		  killsubstrat('AT',teststring,p);
		  killsubstrat('AT',retval,p);
		  insert(teststring,p,'@');
		  insert(retval,p,'@');
	          end else teststring[p]:='&';
	          p:=0;
		end;
                if p <> 0 then begin;
		  gotone:=true;
		  if isInvalidCharAt(retval,p-1) and
isInvalidCharAt(retval,p+3) then begin;
		    killsubstrat('DOT',teststring,p);
		    killsubstrat('DOT',retval,p);
	            insert(teststring,p,'.');
		    insert(retval,p,'.');
		  end else teststring[p]:='&';
		 end;
	until not gotone;
	filterAt:=retval;
end;

function filterwords(s:string):string;
var retval:string;
    p:integer;
    gotone:integer;
    sub:string;
    teststring:string;
begin;
  gotone:=false;
  teststring:=s;
  retval:=s;
  for p:=1 to length(s) do teststring[p]:=upcase(teststring[p]); 
  repeat
    gotone:=false;
    sub:='';
    p:=pos(teststring,'REMOVETHIS');
    if p = 0 then p:=pos(teststring,'NOSPAM') else if
sub = '' then sub:='REMOVETHIS';
    if p = 0 then p:=pos(teststring,'SPAM') else if sub = '' then
sub:='NOSPAM';
    if p = 0 then p:=pos(teststring,'REMOVE') else if sub = '' then
sub:='SPAM';
    if (p <> 0) and (sub = '') then sub:='REMOVE';
    if p <> 0 then begin;
      gotone:=true;
      if isInvalidCharAt(retval,p-1) and
isInvalidCharAt(retval,p+length(sub)) then begin;
        killSubStrAt(sub,teststring,p);
        killSubStrAt(sub,retval,p); 
      end else teststring[p]:='&';
    end; 
  until p = 0;
  filterwords:=retval;
end;
 
function removeExtraMarkers(s:string):string;
var retval:string;
    p:integer;
begin;
    p:=2;
    retval:=s;
    repeat
     if (retval[p] in ['@','.']) and (retval[p-1] in ['@','.']) then
begin;
      if (retval[p] = '@') and (retval[p-1] = '.') then
delete(retval,p-1,1) else delete(retval,p,1);
     end else inc(p);
    until p > length(retval);
end;

function removeBegin(s:string):string;
var retval:string;
begin;
    retval:=s;
    while ((retval[1] = '.') or (retval[1] = '@')) and not (retval = '')
do
begin;
      delete(retval,1,1);
    end;
   removeBegin:=retVal;
end;

function removeEnd(s:string):string;
var retval:string;
begin;
     retval:=s;
     while ((retval[length(retval)] = '.') or (retval[length(retval)] =
'@')) and not (retval = '') do delete(retval,length(retval),1);
    removeEnd:=retval;
end;



begin;
	write('How many e-mails do you want to filter: ');
	readln(numItems);
	
	for cnt:=0 to numItems-1 do readln(list[cnt]);

        for cnt:=0 to numItems-1 do begin;
	
		list[cnt]:=filterAt(list[cnt]);
		list[cnt]:=filterWords(list[cnt]);		
		list[cnt]:=killBrackets(list[cnt]);
		list[cnt]:=killInvalidChars(list[cnt]);
		list[cnt]:=removeExtraMarkers(list[cnt]);
		list[cnt]:=removeBegin(list[cnt]);
		list[cnt]:=removeEnd(list[cnt]);

	end;


end.

