package ot_maillib;
use strict;
use FindBin;
use lib $FindBin::Bin;
#use lib '/data/httpd/lib/perl';
use ot_const qw( %ot $testmode );
use vars qw( @ISA @EXPORT_OK $VERSION );
use Exporter;
$VERSION = 1.01;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
&debug
&mail
&mailerror
&usermail
&split_email_addr
&split_addr
&extract_body
&format_body
);

=head1 NAME

	ot_maillib - open theory mail handling lib

=head1 SYNOPSIS

	library of mail handling functions

=head1 DESCRIPTION

	All functions are described below.

=cut


=head2 &debug - writes debug string to debug file

in-param:	$debugstr - debug text
in-param:	$dlev - debug level
pass-in:	$ot{logpath} - path to log files
returns:	--

=cut

sub debug {
	my( $debugstr, $dlev ) = @_;
	my $dlevel = 2;		# debug level 0, 1, 2
	if ( $dlev <= $dlevel ) {
		open( LH , '>>'.$ot{logpath}.'debug.log' ) || die 'error open log';
		print LH "# $debugstr\n";
		close( LH );
	}
}

=head2 &mail - sends an email to all addressee

in-param:	$to - address list
in-param:	$mailtext - mail text
pass-in:	$ot{logpath} - path to log files
returns:	--

=cut

sub mail {
	my( $to, $mailtext ) =  @_;
	if( $testmode ) {
		open( MH , '>>'.$ot{logpath}.'mail2user.log' ) || die 'error open file!';
	} else {
		open( MH , "| /usr/lib/sendmail -bm $to" ) || die 'error open mh!';
	}
	print MH $mailtext;
	close( MH );		
}

=head2 &mailerror - mailerror sends an error info to admin

in-param:	$msg - error message
pass-in:	$ot{logpath} - path to log files
returns:	--

=cut

sub mailerror {
	my( $msg ) = @_;
	my $txt;
	debug( ">>>>Error:\n$msg", 0 );
	$txt = "From: $ot{listmaster}\@$ot{maildom}\nTo: $ot{listmaster}\@$ot{maildom}\n";
	$txt .= "Subject: open theory - error\n\n";
	$txt .= "Fehler:\n\n$msg\n";
	mail( $ot{listmaster}."\@".$ot{maildom}, $txt );
}

=head2 &usermail - usermail sends an info to user

in-param:	$from - from address, only used if not 0
in-param:	$to_long - user address in long format
in-param:	$to_addr - user address in short format
in-param:	$subj - mail subject
in-param:	$rplto - reply-to address, only used if not 0
in-param:	$text - mail text
returns:	--

=cut

sub usermail {
	my( $from, $to_long, $to_addr, $subj, $rplto, $text ) = @_;
	if( !$from ) { $from = "$ot{listmaster}\@$ot{maildom}"; }
	my $txt = "From: $from\nTo: $to_long\n";
	if( $rplto ) { $txt .= "Reply-to: $rplto\n"; }
	$txt .= "Subject: $subj\n\n$text\n\n";
	mail( $to_addr, $txt );
}

=head2 &split_email_addr - splits long address into alias and address

in-param:	entire email address string
returns:	$email - address part of entire email address
returns:	$alias - alias part of entire email address

=cut

sub split_email_addr {
	my( $email ) = @_;
	my $alias = '';
	$_ = $email;
	if( /(.*)\s*<(.+\@.+)>/ ){
		$alias = $1;
		$email = $2;
	} elsif( /(.+\@.+)\s*\((.+)\)/ ){
		$email = $1;
		$alias = $2;
	} elsif( /\((.+)\)\s*(.+\@.+)/ ){
		$alias = $1;
		$email = $2;
	}
	$email =~ s/\s//g;
	return( $email, $alias );	
}

=head2 &split_name - splits username of emailaddr in first_n and last_n

in-param:	$email - email address like username@domain
returns:	@name - array with firstname and lastname

currently not availble

=cut

sub split_name {
my @name = ();
	$_ = shift;
	s/^\s+//;	# chop whitespaces from start
	s/\s+$//;	# chop whitespaces from end
	s/\"//g;	# chop '"'
	if( /\s/ ){			# test 'x y'
		@name = split( ' ', $_ );
	} elsif( /(\S+\.\S+)\@.+/ ) {	# test 'x.y@dom'
		@name = split( /\./, $1 );
	} elsif( /(\S+\_\S+)\@.+/ ) {	# test 'x_y@dom'
		@name = split( /_/, $1 );
	} elsif( /(.+)\@.+/ ) {		# test 'xy@dom'
		@name = ( substr( $1, 0, 1 ), substr( $1, 1 ));
	} elsif( /\./ ) {		# test 'x.y'
		@name = split( /\./, $_ );
	} elsif( /_/ ) {		# test 'x_y'
		@name = split( /_/, $_ );
	} elsif( /\S+/ ) {		# test 'xy'
		@name = ( substr( $_, 0, 1 ), substr( $_, 1 ));
	}
	return @name;
}

=head2 split_addr - splits alias- or username-part of emailaddr into fn and ln

in-param:	$alias, $email - alias and name part of email address
returns:	( $fn, $ln ) - array with firstname and lastname

=cut

sub split_addr {
my @name = ();
	my( $alias, $email ) = @_;
	my( $fn, $ln ) = ( '', '' );
	@name = split_name( $alias );
	if( $#name < 0 ){	# if no alias present, take emailaddr itself
		@name = split_name( $email );
	}
	if( $#name < 0 ){	# this should never happen
		mailerror( "Namesplit does not work: $email" );
		$fn = "No";
		$ln = "Name";
	} else {
		$ln = ucfirst( pop( @name ));
		$fn = ucfirst( join( ' ', @name ));
	}
	return( $fn, $ln );
}

=head2 extract body - extracts pure text body from email

... and cuts header, footer and multiparts; stringifies and formats the body
text.

in-param:	@mailtxt array
returns:	$body

=cut

sub extract_body {
	my( @mailtxt ) = @_;
	my $bodytxt = '';
	my $boundary = '';
	my $boundpos1 = 0;
	my $boundpos2 = 0;
	my $i = 0;
	foreach ( @mailtxt ){
		$i++;
		if(( !$boundpos1 ) && ( /Content-Type:/i )) {
			debug( "i: $i - \/Content-Type\/", 2 );
			$boundary = ' ';		# just a marker
			if( /boundary=\"*(.+)\"*/ ){ $boundary = $1; }
		}
		elsif( $boundary eq ' ' ) {
			debug( "i: $i - boundary eq ' '", 2 );
			$boundary = '';			# reset marker
			if( /boundary=\"*([^\"\n]+)\"*/ ){ $boundary = $1; }
			debug( "boundary: $boundary", 2 );
		}
		elsif( $boundary ne '' ){		# a MIME-Message
			if(( !$boundpos1 ) && ( /$boundary/ )) {
				debug( "i: $i - !boundpos1 and \/$boundary\/", 2 );
				$boundpos1 = 1;		# mark: 1st boundary found
			}
			elsif(( $boundpos1 == 1 ) && ( /\A\n/ )){
				debug( "i: $i - boundpos1 == 1 and \/\\A\\n\/", 2 );
				$boundpos1 = $i;	# read up to empty line
			}
			elsif(( !$boundpos2 ) && ( /$boundary/ )) {
				debug( "i: $i - !boundpos2 and \/\\A--\/", 2 );
				$boundpos2 = $i;
				last;
			}
		} 
		elsif(( !$boundpos1 ) && ( /\A\n/ )) {	# a rfc-822 message
			debug( "i: $i - !boundpos1 and \/\\A\\n\/", 2 );
			$boundpos1 = $i;
		}
	}
	if( !$boundpos2 ) { $boundpos2 = $i; }
	debug( "boundpos1: $boundpos1, boundpos2: $boundpos2", 2 );
	$boundpos2 -= 2;
	$bodytxt = join( '', @mailtxt[ $boundpos1 .. $boundpos2 ]);
	return( $bodytxt );
}

=head2 format_body - formats body email text

Stringifies body text, deletes empty lines, cuts footer

in-param:	$body
returns:	$body

=cut

sub format_body {
	my( $body ) = @_;
	my @bodytxt = ();
	my @mailtxt = split( "\n", $body );
	foreach ( @mailtxt ){
		if( /\A--/ ) {
			last;
		}
		elsif( !/\A\n/ ) {
			push( @bodytxt, $_ );
		}
	}
	$body = join( '', @bodytxt );
	$_ = $body;
	while( s/  / /gc ) {}			# elim multi-blanks
	$body = $_;
	debug( "Bodytext:\n$body", 2 );
	return( $body );
}
1;
