#!/local/bin/perl5
##############################################################################
# $Id: emailparser.txt,v 1.1 2003/03/28 23:48:29 xwolf Exp $          #            
# COPYRIGHT NOTICE                                                           #
# Copyright 1999 Wolfgang Wiese     All Rights Reserved.                     #
#       EMail: xwolf@xwolf.com                                               #
#       URL  : http://www.xwolf.com                                          #
#                                                                            #
# This script may be used and modified free of charge by anyone so long as   #
# this copyright notice and the comments above remain intact.  By using this #
# code you agree to indemnify Wolfgang Wiese from any liability that         #  
# might arise from it's use.                                                 #  
#                                                                            #
# Selling the code for this program without prior written consent is         #
# expressly forbidden.  In other words, please ask first before you try and  #
# make money off of my program.                                              #
#                                                                            #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium.	In all cases copyright and header must remain intact.#
##############################################################################
# Last Modified on:	$Date: 2003/03/28 23:48:29 $
# By:			$Author: xwolf $
# Version:		$Revision: 1.1 $ 
##############################################################################
use strict;

my $DEBUG =$ARGV[1];
	# Zum Debugging
my $key;
	# Laufvariable fuer Hashes
my $TEXTMAIL_BEZEICHNUNG = "Noname";
	# Bezeichner fuer E-mails aus reinen Text
my $SORT_METHODE = $ARGV[2];
	# Welche Sortierung nehmen wir fuer die Asugabeliste der E-Mails?
	# Moeglichkeiten:
	#	0 : Sortierung nach Alphabet beginnend bei (Login)Namen
	#	1 : Sortierung nach Domainnamen, und falls mehrere
	#	    unter einer Domain dann nach Namensalphabet
my $GATHER_EMAIL = $ARGV[3];
	# Wie werden E-Mailadressen gesammelt: Werden Doppelte 
	# E-Mailadressen geloescht oder mitgespeichert?
	#	0 : Doppelte E-Mailadressen werden ignoriert, nur doppelte
	#	    Bezeichner werden mit gespeichert.
	#	1 : Doppelte E-Mailadressen werden ignoriert, nur der
	#	    erste Bezeichner wird verwendet.
	#	2 : Jede E-Mailadresse wird gespeichert, auch doppelte
my $HTMLTAG_CLEAN = $ARGV[4];
	# Es kann passieren, das in den ASCII-Text einzelne Zeichen von '<'
	# oder '>' vorkommen, obwohl damit keine HTML-Tags gemeint
	# sind. 
	# Wenn dies beruecksichtigt werden soll, dann wird angenommen,
	# das alle HTML-Tags sauber sind, d.h. wenn ein Leerzeichen
	# nach dem '<' kommt, handelt es sich nicht um ein HTML-Tag
	# und dieses Zeichen wird durch die STRINGS "groesser" und
	# "kleiner" ersetzt.
	# Zum Ausschalten dieser Funktion geben Sie hier ein Wert != 0 an.	
my $GREATER_THAN = "groesser";
my $SMALLER_THAN = "kleiner";

my @MAILLISTE;
	# Hierin werden alle E-Mailadressen geschrieben

##############################################################################
# Main program starts after this point. Change only if you know what to do.
##############################################################################
if (not $ARGV[0]) {
  print STDERR "Syntax: $0 (Dateiname) (debug) (Sortierung) (Email-Sammlung) (Kein sauberes HTML)\n";
  print "wo:\n";
  print "\t(debug):          1/0 Set Debugging on/off\n";
  print "\t(Sortierung):     0 - Sortierung einfach nach Loginnamen\n";
  print "\t                  1 - Sortierung beruecksichtigt Domainname\n";
  print "\t(Email-Sammlung): 0 - Ignoriere Doppelte E-Mailadressen, sammle doppelte Bezeichner\n";
  print "\t                  1 - Ignoriere Doppelte E-Mailadressen und Bezeichner\n";
  print "\t                  2 - Jede E-Mailadresse wird gespeichert, auch doppelte\n";
  print "\t(Kein sauberes HTML): 1/0 Schaltet die Beruecksichtigung von sauberen\n";
  print "\t                  HTML aus.\n";
  exit(1);
}
if ($DEBUG) { print "Lese Datei $ARGV[0]"; }
my $text = &ReadFileContent($ARGV[0]);
if ($DEBUG==2) { 
  print "$text\n";
}
if ($DEBUG) { print "\t\tok\n"; }

if ($DEBUG) { print "Starte Parser...\n"; }

my @LISTE = &ParseMails($text,$GATHER_EMAIL,$SORT_METHODE,$HTMLTAG_CLEAN);

if ($DEBUG) { print "...ok\n"; }

if ($DEBUG) { print "Ergebnisse:\n"; }

my $run;
for ($run=0; $run<=$#LISTE; $run++) {
  print "$LISTE[$run]\n";
}

exit(0);
##############################################################################
# Subroutinen
##############################################################################
sub ParseMails {
  my $parsetext = $_[0];
  my @MAILLISTE;
  my $OPT_GATHER = $_[1];
  my $OPT_SORT = $_[2];
  my $OPT_CLEAN = $_[3];
  
  if (not $OPT_CLEAN) {
    $parsetext =~ s/<\s+/$SMALLER_THAN/g;
    $parsetext =~ s/\s+>/$GREATER_THAN/g;
  }
  if ($parsetext =~ /<.*>/i) {
   &ParseEMailfromHTML($parsetext);
  	# Zuerst parsen wir den Text nach HTML-Links, sofern
  	# in diesem ueberhaupt HTML-Tags vorkommen
        # jetzt beseitigen wir noch alle moeglicherweise vorhandenen
        # HTML-Tags fuer die folgende ASCII-Bearbeitung
    $parsetext =~ s/<([^>]|\n)*>//g;
  } else {
    if ($DEBUG) {
      print "\tText enthaelt keine HTML-Tags\n";
    }
  }
  
  # Als naechstes pruefen wir nur den (verbleibenden) ASCII-Text
  # nach E-mailadressen.
  
  &ParseEMailfromASCII($parsetext);
  	# Hier parsen wir die E-Mailadressen aus dem Text
  	
  &SortMailAdresses;
  	# Nun sortieren wir noch.
  	
  return @MAILLISTE;


  ##############################################################################
  sub SortMailAdresses{
    my $i;
    my ($thismail, $thisbez);
    my ($thislogin, $thisdomain);
    my @DOMAINLIST;
    
    @MAILLISTE = sort @MAILLISTE;
    if ($OPT_SORT==1) {
      for ($i=0; $i<=$#MAILLISTE; $i++) {
        ($thismail, $thisbez) = split(/\|/,$MAILLISTE[$i],2);
        ($thislogin, $thisdomain) = split(/\@/,$thismail,2);
        push(@DOMAINLIST,"$thisdomain, $thislogin, $thisbez");
      }
      @DOMAINLIST = sort @DOMAINLIST;
      @MAILLISTE = ();
      
      for ($i=0; $i<=$#DOMAINLIST; $i++) {
        ($thisdomain, $thislogin, $thisbez) = split(/, /,$DOMAINLIST[$i],3);
        push(@MAILLISTE,"$thislogin\@$thisdomain\|$thisbez");
      }
    } 
  }
  ##############################################################################
  sub Push_EMail_Liste {
    my $new_name = $_[0];
    my $new_value = $_[1];
    my $z;
    my ($cname, $cval);
    my $found;
    if ($OPT_GATHER==1) {
      for ($z=0; $z<=$#MAILLISTE; $z++) {
        ($cname, $cval) = split(/\|/,$MAILLISTE[$z],2);
        if (uc($cname) eq uc($new_name)) {        
          $found = 1;
          last;
        }
      }
      if (not $found) {
        push(@MAILLISTE,"$new_name|$new_value");
      }    
    } elsif ($OPT_GATHER==2) {
      push(@MAILLISTE,"$new_name|$new_value");  
    } else {
      for ($z=0; $z<=$#MAILLISTE; $z++) {
        ($cname, $cval) = split(/\|/,$MAILLISTE[$z],2);
        if ((uc($cname) eq uc($new_name)) && (uc($cval) eq uc($new_value))){        
          $found = 1;
          last;
        }
      }
      if (not $found) {
        push(@MAILLISTE,"$new_name|$new_value");
      }
    }
  }
  ##############################################################################
  sub ParseEMailfromASCII {
    my $parseascii_text = $_[0];
    my @ZEILE = split(/[\n\r]/,$parseascii_text);
    my @WORT;
    my $l;
    my $thisemail;
    my $thisbezeichner;
    my $t;
  
    # Vorgehen: Ich teile den Text zuerst in Zeilen
    # Danach geh ich in die einzelnen Zeilen un dparse dort nach E-Mails.
    for ($l=0; $l<=$#ZEILE; $l++) {
      if (length($ZEILE[$l]) < 6) {
        next;
      }
      if ($ZEILE[$l] =~ /\s*([\w.-]+\@[\w.-]+)[\|\:](.+?)/i) {
    	# Es handelt sich offensichtlich bei dieser Zeile um eine bereits
    	# vorformatierte Ausgabe, die auch von diesem Programm bei einem 
    	# anderem Lauf gemacht wurde
    	($thisemail, $thisbezeichner) = split(/[\|\:]/,$ZEILE[$l],2);
    	&Push_EMail_Liste($thisemail, $thisbezeichner);
     	
          if ($DEBUG) {
            print "\tParseEMailfromASCII (Preformated): $ZEILE[$l]\n";
          }
      } else {
        @WORT = split(/\s+/,$ZEILE[$l]);
        for ($t=0; $t<=$#WORT; $t++) {
          if ($WORT[$t] =~ /\@/) {
            $WORT[$t] =~ s/[\(\)\[\]]//g;
            if ($WORT[$t] =~ /([\w.-]+\@[\w.-]+\.[\w.-]+)/) {
              if ($DEBUG) {
                print "\tParseEMailfromASCII (Standard): $WORT[$t]\n";
              }
              $WORT[$t] =~ s/(?:["\'\s]?)//g;  
              $WORT[$t] =~ s/mailto://gi;
              &Push_EMail_Liste($WORT[$t], $TEXTMAIL_BEZEICHNUNG);          
            }
          }
        } 
      }
    }
  
  }
  ##############################################################################
  sub ParseEMailfromHTML {
    my $parselink_text = $_[0];
    my $parselink_email;
    my $parselink_bezeichner;
  
    while ($parselink_text) {
      if ($parselink_text =~ /<a\s*(.*?)mailto:([\w.-]+\@[\w.-]+\.[\w.-]+)(?:["\'\s]?)\s*(.*?)>(.*?)<\/a>/si) {
	if ($DEBUG) { print "\tParseEMailfromHTML: $2\n"; }

        $parselink_text = $';        
        $parselink_email = $2;
        	# $1 enthaelt Argumente von <a> vor dem href
        	# $2 enthaelt die Mailadresse
        	# $3 enthaelt alles nach der Mailadresse und vor dem Bezeichner
        	# $4 enthaelt den Bezeichner, wobei hier aber noch andere HTML-Tags 
        	# drin vorkommen koennen.
        	# $' enthaelt den Text nach </a>.
        $parselink_bezeichner = $4;
        $parselink_bezeichner =~ s/<([^>]|\s+)*>//g;
        $parselink_bezeichner =~ s/\s+/ /g;
        $parselink_bezeichner =~ s/^\s+//g;
        
        if ($parselink_email =~ /^[\w.-]+\@[\w.-]+\.[\w.-]+/) {
          &Push_EMail_Liste($parselink_email, $parselink_bezeichner);
        }
      } else {
        $parselink_text="";
      }
    }
  }

}
##############################################################################
sub ReadFileContent {
  my $filename = $_[0];
  my $result;
  
  if (-r $filename) {
    open(f1,"$filename") || die("Error on reading \"$filename\".");
      while(<f1>) {
        $result .= $_;
      }
    close f1;
  } else {
    die("File \"$filename\" is not readable.");
  }
  return $result;
}
##############################################################################
# EOF
##############################################################################