package Yaa::Message;

use strict;
use IO::File;
use IO::Handle;
use IO::Scalar;

use constant CRLF => "\r\n";

# set debugging constant if YAA_DEBUG environment variable is set
BEGIN {
	use constant DEBUG => ((defined $ENV{YAA_DEBUG}) ? 1 : 0);
	require File::Basename if (DEBUG);
}

####################################################
#            OBJECT CONSTRUCTOR                    #
####################################################

sub new {
	my $proto = shift;
	my $args = shift;
	my $class = ref($proto) || $proto;
	my $self = {};

	# last error
	$self->{error} = undef;
	$self->{dont_close_fh} = 1;
	$self->{_msg_fh} = undef;

	bless($self, $class);
	
	$self->clearParams();
	return $self;	
}


####################################################
#               PUBLIC METHODS                     #
####################################################

# returns last error
sub error {
	my ($self) = @_;
	return $self->{error};	
}

sub clearParams {
	my ($self) = @_;

	$self->{error} = undef;
	
	$self->{_msg_fh} = undef;

	# Parsed flag
	$self->{_parsed} = 0;

	# header array
	$self->{_msg_headers} = ();
	
	# message headers as string
	$self->{_msg_headers_str} = undef;
	
	# message body
	$self->{_msg_body} = undef;
	
	# message sender
	$self->{_msg_sender} = undef;
	
	# message sender's name, if any
	$self->{_msg_sender_name} = undef;
	
	# To: recipients
	$self->{_msg_recips_to} = ();

	# Cc: recipients
	$self->{_msg_recips_cc} = ();

	# Bcc: recipients
	$self->{_msg_recips_bcc} = ();
	
	# Content-Type specific flags
	%{$self->{_msg_content_type}} = ();
	
	# Message flags
	# message is mailing list post
	$self->{_msg_flag_mailinglist} = 0;

	return 1;
}

# returns sender's email address or undef on error
sub getSenderAddr {
	my ($self) = @_;
	
	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}

	return $self->{_msg_sender};
}

# returns sender's name or undef on error
sub getSenderName {
	my ($self) = @_;
	
	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}

	$self->{_msg_sender_name};
}

# To: recipients methods

# returns array of all To: recipient addresses or undef on error
sub getToRecipients {
	my ($self) = @_;
	
	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}

	return(sort keys %{$self->{_msg_recips_to}});
}

sub getAllRecipients {
	my ($self) = @_;
	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}

	return ($self->getToRecipients(), $self->getCcRecipients);	
}

# returns name of to: recipient, if any
# @param string recipient email address
sub getToRecipientName {
	my ($self, $addr) = @_;
	$addr = lc($addr);

	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}
	elsif (! defined $self->{_msg_recips_to}->{$addr}) {
		$self->{error} = "Recipient $addr is not part of To: header.";
		return undef;
	}
	
	return $self->{_msg_recips_to}->{$addr};
}

# Cc: recipient methods

# returns array of all Cc: recipient addresses or undef on error
sub getCcRecipients {
	my ($self) = @_;
	
	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}

	return(sort keys %{$self->{_msg_recips_cc}});
}

# returns name of Cc: recipient, if any
# @param string recipient email address
sub getCcRecipientName {
	my ($self, $addr) = @_;
	$addr = lc($addr);

	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return undef;
	}
	elsif (! defined $self->{_msg_recips_cc}->{$addr}) {
		$self->{error} = "Recipient $addr is not part of Cc: header.";
		return undef;
	}
	
	return $self->{_msg_recips_cc}->{$addr};
}


# returns recipient name on success as string, undef on error
# searches in To: and Cc: headers
# @argument string email address
sub getRecipientName {
	my ($self, $addr) = @_;
	my $name = undef;
	
	if ($name = $self->getToRecipientName($addr)) {
		return $name;
	}
	elsif ($name = $self->getCcRecipientName($addr)) {
		return $name;
	}
	
	return undef;
}

sub getDeliveredTo {
	my ($self) = @_;
	return lc($self->getHeader('Delivered-To'));
}

sub getContentType {
	my ($self) = @_;
	return $self->{_msg_content_type}->{content_type};
}

sub getCharset {
	my ($self) = @_;
	return $self->{_msg_content_type}->{charset};
}

sub getOriginalTo {
	my ($self) = @_;
	return lc($self->getHeader('X-Original-To'));
}

sub getReplyTo {
	my ($self) = @_;
	my $addr = lc($self->getHeader('Reply-To'));
	$addr = $self->get_sender if (! defined $addr);
	
	return $addr;
}
# is this message a mailing list post?
sub isMailingListPost {
	my ($self) = @_;
	
	if (! $self->{_parsed}) {
		$self->{error} = "Message wasn't yet parsed.";
		return 0;
	}
	
	return $self->{_msg_flag_mailinglist};
}


sub isParsed {
	my ($self) = @_;
	return $self->{_parsed};	
}

# parses string message
# returns 1 on success, 0 otherwise
# @argument string message reference
sub parseString {
	my ($self, $msg) = @_;
	
	if (! defined $msg) {
		$self->{error} = "To few arguments.";
		return 0;
	}
	elsif (ref($msg) ne 'SCALAR') {
		$self->{error} = "Message parameter must be provided as reference.";
		return 0;
	}

	# create IO::Stringy argument && parse filehandle and return result
	if (my $fh = IO::Scalar->new($msg)) {
		my $result = $self->parseFh($fh);
		$fh = undef;
		return $result;
	}

	$self->{error} = "Cannot open filehandle on message string.";
	return 0;
}

sub parseFdByFileno {
	my ($self, $fileno) = @_;
	
	if (! defined $fileno) {
		$self->{error} = "File number was not specified.";
		return 0;
	}

	# create IO::Handle argument && parse filehandle and return result
	if (my $fh = IO::Handle->new($fileno, 'r')) {
		my $result = $self->parseFh($fh);
		$fh = undef unless($self->{dont_close_fh});
		return $result;
	}

	$self->{error} = "Cannot open filehandle: " . $!;
	return 0;
}

# Parses file
# returns 1 on success, 0 otherwise
# @argument string filename
sub parseFile {
	my ($self, $file) = @_;

	if (! defined $file) {
		$self->{error} = "Filename was not provided.";
		return 0;
	}

	# open new filehandle && parse
	if (my $fh = IO::File->new($file, 'r')) {
		my $result = $self->parseFh($fh);
		$fh = undef unless($self->{dont_close_fh});
		return $result;
	}

	$self->{error} = "Unable to open file: " . $!;
	return 0;
}

# returns message filehandle
sub getMessageFh {
	my ($self) = @_;
	unless ($self->{dont_close_fh}) {
		$self->{error} = "Object not set to save message filehandle.";
		return undef;
	}
	
	return $self->{_msg_fh};
}

# Parses filehandle
# returns 1 on success, 0 otherwise
# @argument IO::Handle object
sub parseFh {
	my ($self, $fh) = @_;
	
	# argument reference
	my $ref = ref($fh);

	# we are still in message headers, while reading message
	my $headers = 1;

	# single message line
	my $line = undef;
	
	# Last header name
	my $last_header_name = undef;

	# callback function for last header line
	my $callback = undef;
	
	# we're in header
	
	if (! defined $fh) {
		$self->{error} = "Filehandle argument was not provided.";
		return 0;
	}
	elsif ((! length($ref) && substr($fh, 0, 1) ne '*') && substr($ref, 0, 4) ne 'IO::') {
		$self->{error} = "Provided filehandle argument is not opened filehandle";
		return 0;
	}
	
	# set filehandle object
	$self->{_msg_fh} = $fh if ($self->{dont_close_fh});

	##############################
	# read line by line and parse#
	##############################
	while ($headers && ($line = $fh->getline)) {
		# wipe out trailing \r's and \n's
		$line =~ s/([\r\n]*$)//;
		print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", parseFh(), line ", __LINE__, ": Read line '$line'\n" if (DEBUG);

		# if length is zero characters, this is an end of headers
		if (! length($line)) {
			$headers = 0;
			last;
		}
		# write header
		$self->{_msg_headers_str} .= $line . CRLF;
		
		my $header_value = undef;

		# parse line
		# this is header
		if ($line =~ m/^([\w\-]+): (.*)$/)  {
			$last_header_name = $1;
			$header_value = $2;
			
			$callback = undef;
			_trim($header_value);

			print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", parseFh(), line ", __LINE__, ": header: '$last_header_name', value: '$header_value'\n" if (DEBUG);
			
			# From: header
			if ($last_header_name eq 'From') {
				$self->_parse_header_from(\ $header_value);

				$callback = sub {
					return $self->_parse_header_from($_[0]);
				};
			}
			# To: headers
			# This header should be chopped with values
			elsif ($last_header_name eq 'To') {
				$self->_parse_header_to(\ $header_value);
				
				$callback = sub {
					return $self->_parse_header_to($_[0]);
				};
			}
			elsif ($last_header_name eq 'Cc') {
				$self->_parse_header_cc(\ $header_value);
				
				$callback = sub {
					$self->_parse_header_cc($_[0]);
				};
			}
			# Content-Type
			elsif ($last_header_name eq 'Content-Type') {
				$self->_parse_header_content_type(\ $header_value);
				
				$callback = sub {
					$self->_parse_header_content_type($_[0]);
				};
			}
			# This is just normal header
			else {
				$self->_parse_header_std($last_header_name, \ $header_value);
			}
		}
		# this is multiline header
		else {
			_trim($line);
			print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", parseFh(), line ", __LINE__, ": multiline header '$last_header_name', value '$line'\n" if (DEBUG);
			# we need to continue from the previous header
			if (ref($callback) eq 'CODE') {
				&{$callback}(\ $line);
			} else {
				$self->_parse_header_std($last_header_name, \ $line);
			}
		}
	}

	# WEIRD!!!
	# End of message headers. Store message in object if necessary
	#if ($self->{_store_message}) {
	#	$self->{_msg_body} .= $_ while ($line = $fh->getline);
	#}
	
	# is this a mailing list post?
	if (
			lc($self->getHeader('Precedence', 1)) eq 'list' ||
			$self->getHeader('List-Id', 1) ||
			$self->getHeader('List-Subscribe', 1) ||
			$self->getHeader('List-Unsubscribe', 1) ||
			$self->getHeader('List-Archive', 1) ||
			$self->getHeader('List-Post', 1) ||
			$self->getHeader('X-Mailing-List', 1) ||
			$self->getHeader('Mailing-List', 1) ||
			$self->getHeader('X-List', 1)
		) {
		$self->{_msg_flag_mailinglist} = 1;
	}
	
	# is this message really not an mailing list post?
	my $real_snd;
	if (! $self->{_msg_flag_mailinglist} && length ($real_snd = lc($self->getHeader('Sender', 1))) && length $self->{_msg_sender} && $real_snd ne $self->{_msg_sender}) {
		$self->{_msg_flag_mailinglist} = 1;
	}
	
	# set parsed flag
	$self->{_parsed} = 1;
	
	$self->{error} = undef;

	# return success
	return 1;
}

# returns message header value as string on success, undef otherwise
# @argument string message header key
# @argument integer case insensitive search
# @argument string multiple header separator (default " ")
sub getHeader{
	my ($self, $key, $insensitive, $separator) = @_;
	
	$separator = " " if (! defined $separator);

	if (! defined $key) {
		$self->{error} = "Header key was not provided.";
		return undef;
	}
	
	if ($insensitive) {
		$key = lc($key);
		foreach my $header_key (keys %{$self->{_msg_headers}}) {
			return join($separator, @{$self->{_msg_headers}->{$header_key}}) if (lc($header_key) eq $key);
		}
	} else {
		return join($separator, @{$self->{_msg_headers}->{$key}}) if (defined $self->{_msg_headers}->{$key});
	}
	
	$self->{error} = "No such header with name '$key'.";
	return undef;
}

sub getHeadersAsString {
	my ($self) = @_;
	return $self->{_msg_headers_str};
}

sub getHeaderAsArray {
	my ($self, $key, $insensitive) = @_;

	if (! $self->{_parsed}) {
		$self->{error} = "Message not parsed yet.";
		return 0;
	}
	elsif (! defined $key) {
		$self->{error} = "Header key was not provided.";
		return undef;
	}

	if ($insensitive) {
		$key = lc($key);
		foreach my $header_key (keys %{$self->{_msg_headers}}) {
			return @{$self->{_msg_headers}->{$header_key}} if (lc($header_key) eq $key);
		}
	} else {
		return @{$self->{_msg_headers}->{$key}} if (defined $self->{_msg_headers}->{$key});
	}

	$self->{error} = "No such header with name '$key'.";
	return undef;
}

sub getHeaderNames {
	my ($self) = @_;
	my @results;
	
	foreach (keys %{$self->{_msg_headers}}) {
		push(@results, $_);
	}
	
	return @results;
}

# returns message headers as string
sub getMessageHeaders {
	my ($self, $str) = @_;

	if (! $self->{_parsed}) {
		$self->{error} = "Message not parsed yet.";
		return 0;
	}
	elsif (! $self->{_store_headers}) {
		$self->{error} = "Message headers were not saved into object.";
		return 0;
	}
	elsif (ref($str) ne 'SCALAR') {
		$self->{error} = "Second argument must be provided as scalar reference.";
		return 0;
	}
	
	# hmm :)
	$$str = undef;

	foreach my $header (keys %{$self->{_msg_headers}}) {
#		$$str
	}
}

####################################################
#               PRIVATE METHODS                    #
####################################################

# parses From: line
# @argument string From: message header value reference
# returns 1 on success, 0 otherwise
sub _parse_header_from {
	my ($self, $value) = @_;
	my $addr = undef;
	my $name = undef;
	
	
	if (! defined $value) {
		$self->{error} = "Message header value was not provided.";
		return 0;
	}
	elsif (ref($value) ne 'SCALAR') {
		$self->{error} = "First argument (value) not provided as scalar reference";
		return 0;
	}
	
	if ($$value =~ m/^['"]?([\w\.\=\-\?\ ]+)["']? <([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})>$/i) {
		$addr = $2 . "@" . $3 . "." . $4;
		$name = $1;
	}
	elsif ($$value =~ m/^<([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})>$/) {
		$addr = $1 . "@" . $2 . "." . $3;
	}
	elsif ($$value =~ m/^([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})$/) {
		$addr = $addr = $1 . "@" . $2 . "." . $3;
	}
	
	my $result = 0;
	# assign
	if ($addr) {
		$self->{_msg_sender} = lc($addr);
		$self->{_msg_sender_name} = $name;
		$result = 1;
	}
	
	# put into headers array
	push(@{$self->{_msg_headers}->{From}}, $$value);

	return $result;
}

# Parses To: line
# @argument string To: message header value reference
# returns 1 on succes, 0 otherwise
sub _parse_header_to {
	my ($self, $value) = @_;
	
	if (! defined $value) {
		$self->{error} = "Message header value was not provided.";
		return 0;
	}
	elsif (ref($value) ne 'SCALAR') {
		$self->{error} = "First argument (value) not provided as scalar reference";
		return 0;
	}

	# process every item found
	foreach my $item (split(/,/, $$value)) {
		my $addr = undef;
		my $name = undef;
		
		_trim($item);

		# check string length
		next if (! length($item));


		if ($item =~ m/^['"]?([\w\.\=\-\?\ ]+)["']? <([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})>$/i) {
			$addr = $2 . "@" . $3 . "." . $4;
			$name = $1;
		}
		elsif ($item =~ m/^<([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})>$/) {
			$addr = $1 . "@" . $2 . "." . $3;
		}
		elsif ($item =~ m/^([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})$/) {
			$addr = $addr = $1 . "@" . $2 . "." . $3;
		}
		
		# assign
		if ($addr) {
			$self->{_msg_recips_to}->{lc($addr)} = $name;
		}
	}

	# put into headers array
	push(@{$self->{_msg_headers}->{To}}, $$value);

	return 1;
}

# Parses Cc: line
# @argument string Cc: message header value reference
# returns 1 on succes, 0 otherwise
sub _parse_header_cc {
	my ($self, $value) = @_;
	
	if (! defined $value) {
		$self->{error} = "Message header value was not provided.";
		return 0;
	}
	elsif (ref($value) ne 'SCALAR') {
		$self->{error} = "First argument (value) not provided as scalar reference";
		return 0;
	}
	
	# process every item found
	foreach my $item (split(/,/, $$value)) {
		my $addr = undef;
		my $name = undef;
		
		_trim($item);

		# check string length
		next if (! length($item));
		
		if ($item =~ m/^['"]?([\w\.\=\-\?\ ]+)["']? <([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})>$/i) {
			$addr = $2 . "@" . $3 . "." . $4;
			$name = $1;
		}
		elsif ($item =~ m/^<([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})>$/) {
			$addr = $1 . "@" . $2 . "." . $3;
		}
		elsif ($item =~ m/^([a-z0-9\._-]+)@([a-z0-9\._-]+)\.([a-z]{2,4})$/) {
			$addr = $addr = $1 . "@" . $2 . "." . $3;
		}
		
		# assign
		if ($addr) {
			$self->{_msg_recips_cc}->{lc($addr)} = $name;
		}
	}

	# put into headers array
	push(@{$self->{_msg_headers}->{Cc}}, $$value);

	return 1;
}

# Parses Content-Type header
# @argument string Cc: message header value reference
# returns 1 on succes, 0 otherwise
sub _parse_header_content_type {
	my ($self, $value) = @_;
	
	if (! defined $value) {
		$self->{error} = "Message header value was not provided.";
		return 0;
	}
	elsif (ref($value) ne 'SCALAR') {
		$self->{error} = "First argument (value) not provided as scalar reference";
		return 0;
	}

	foreach my $v (split(/[;]/, $$value)) {
		_trim($v);
		if ($v =~ m/^([\w\-]+)=['"]?([\w\-]+)["']?$/) {
			$self->{_msg_content_type}->{lc($1)} = $2;
		} else {
			$self->{_msg_content_type}->{content_type} = $v;
		}
	}

	# put into headers array
	push(@{$self->{_msg_headers}->{'Content-Type'}}, $$value);

	return 1;	
}


# Parses standard header
# @argument string header name
# @argument string header value reference
sub _parse_header_std {
	my ($self, $key, $value) = @_;
	
	if (! defined $value) {
		$self->{error} = "To few arguments.";
		return 0;
	}
	elsif (ref($value) ne 'SCALAR') {
		$self->{error} = "First argument (value) not provided as scalar reference";
		return 0;
	}
	
	# put into headers array
	push(@{$self->{_msg_headers}->{$key}}, $$value);
	
	return 1;
}


####################################################
#               HELPER FUNCTIONS                   #
####################################################

# removes whitespaces at the begging and end of string
sub _trim {
	$_[0] =~ s/^\s*//;
	$_[0] =~ s/\s*$//;
}

1;
