package Yaa;

use strict;
use DB_File;
use IO::Scalar;
use IO::File;

use constant DEFAULT_TF_INTEVAL => 3600;

use Yaa::Message;

# 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);
}

=head1 NAME

Yaa - Yet another autoresponder main Perl module

=head1 SYNOPSIS

    use Yaa;
    use Yaa::Autoresponse;
    use Yaa::Log;
    use Yaa::LookupMap;

    # Constructors
    my $yaa = Yaa->new(
    	param => 'value'
    );
    
    my $map = Yaa::LookupMap->new(
    	param => 'value'
    );
    
    my $autoresponse = Yaa::Autoresponse->new(
    	param => 'value'
    );
    
    $yaa->addLookupMap("map_name", $map);
    $yaa->setAutoresponse($autoresponse);
    
    # process message(s)
    $yaa->processMessage(\ $message_string)
    $yaa->processMessageByFileno(fileno(STDIN));
    $yaa->processMessageFh($filehandle);
    $yaa->processMessageFile("email.txt");
    
=head1 DESCRIPTION

this will be description... some day.

=cut


=head1 OBJECT CONSTRUCTOR

This is object constructor

=cut

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

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

	##################################################
	#               PUBLIC VARS                      #
	##################################################
	
	$self->{error} = undef;		# last error accoured

	# timeframe
	$self->{tf_duration_interval} = 600;
	$self->{db_dir} = ".";
	
	# autoresponse lookup tables list
	%{$self->{tables_lookup_list}} = ();

	##################################################
	#              PRIVATE VARS                      #
	##################################################

	$self->{_ar} = undef;			# initialized Yaa::Autoresponse object
	$self->{_log} = undef;			# initialized Yaa::Log object
	
	$self->{_lookup_map_regex} = qr/(\w+):(\w+)/;
	
	%{$self->{_lookup_maps}} = ();	# initialized Yaa::LookupMap::XXX objects
	
	$self->{_msgid} = undef;		# current message processing id

	bless($self, $class);
	
	$self->clearParams();
	$self->setParams(@_);

	return $self;
}

=head1 METHODS

=cut

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

sub TIEHANDLE {
	my ($self) = @_;
	if (substr(ref($self), 0, 3) eq 'Yaa') {
		return $self;
	}
	return Yaa->new(@_);
}

sub PRINT {
	my ($self) = shift;
	return $self->_logger(@_);
}

=head2 clearParams ()

Clears all object parameters and sets defaults. Always returns 1.

=cut
sub clearParams {
	my ($self) = @_;
	
	$self->{error} = undef;
	$self->{tf_duration_interval} = DEFAULT_TF_INTEVAL;
	$self->{db_dir} = ".";
	%{$self->{tables_lookup_list}} = ();
	$self->{_ar} = undef;
	$self->{_log} = undef;
	%{$self->{_lookup_maps}} = ();
	
	return 1;
}

=head2 setParams (key => value, key2 => value2)

Sets object's parameters. For parameter see object constructor's arguments. Always returns 1.

=cut
sub setParams {
	my ($self) = shift;

	while ((my $name = shift) && (my $value = shift)) {
		$self->{$name} = $value if (substr($name, 0, 1) ne '_');
	}
	
	return 1;
}

=head2 setLogger ($log)

Sets logging subsystem. All major actions will be logged transparently inside instance of Yaa class.
Argument must be initialized Yaa::Log object.

Returns 1 on success, otherwise 0.

=cut
sub setLogger {
	my ($self, $log) = @_;

	if (ref($log) ne 'Yaa::Log') {
		$self->{error} = "Argument is not initialized Yaa::Logg object.";
		return 0;
	}
	
	$self->{_log} = $log;
	return 1;
}

=head2 destroyLogger ()

Disables logging subsystem if it was enabled with setLogger() method.

Always returns 1.

=cut
sub destroyLogger {
	my ($self) = @_;
	$self->{_log} = undef;
	return 1;
}

=head2 setAutoresponse ($autoresponse_obj)

Sets initialized Yaa::Autoresponse object. Returns 1 on success, otherwise 0.

=cut
sub setAutoresponse {
	my ($self, $ar) = @_;
	
	if (ref($ar) ne 'Yaa::Autoresponse') {
		$self->{error} = "Argument is not initialized Yaa::Autoresponse object.";
		return 0;
	}
	
	$self->{_ar} = $ar;
	return 1;
}

=head2 addLookupMap ($name, $map)

Adds new initialized Yaa::LookupMap::<DRIVER> object into Yaa object instance, which can be later referenced with $name:result_name.
Returns 1 on success, otherwise 0.

=cut
sub addLookupMap {
	my ($self, $name, $obj) = @_;
	
	if (! (defined $name && length $name)) {
		$self->{error} = "Lookup map name was not defined.";
		$self->_logger("Error: Unable to add lookup map: " . $self->{error});
		return 0;
	}
	elsif (substr(ref($obj), 0, 16) ne 'Yaa::LookupMap::') {
		$self->{error} = "Lookup map object must be initialized Yaa::LookupMap::DRIVER object.";
		$self->_logger("Error: Unable to add lookup map: " . $self->{error});
		return 0;
	}
	
	# assign map
	$self->{_lookup_maps}->{$name} = $obj;
	return 1;
}

=head2 removeLookupMap ($name)

Removes previously added lookup map via addLookupMap() method with name $name. Returns 1 on success, otherwise 0.

=cut
sub removeLookupMap {
	my ($self, $name) = @_;
	if (! defined $name) {
		$self->{error} = "Unable to remove undefined lookup map.";
		$self->_logger("Error: Unable to remove lookup map: " . $self->{error});
		return 0;
	}
	elsif (! defined $self->{_lookup_maps}->{$name}) {
		$self->{error} = "Lookup map '$name' was never assigned.";
		$self->_logger("Error: Unable to remove lookup map: " . $self->{error});
		return 0;
	}
	
	# remove lookup map.
	$self->{_lookup_maps}->{$name} = undef;
	delete $self->{_lookup_maps}->{$name};
	
	return 1;
}

=head2 setLookupMapQueryOrder ($name, ...)


=cut
sub setLookupMapQueryOrder {
	my $self = shift;
	my $name = shift;
	
	if (! defined $name) {
		$self->{error} = "Unable to set lookup map query order for undefined attribute";
		return 0;
	}
	elsif (! @_) {
		$self->_logger("Warning: setting empty lookup query order for attribute '$name'.");
	}
	
	# set query list
	@{$self->{tables_lookup_list}->{$name}} = @_;
	
	return 1;
}

=head2 getLookupMapQueryOrder ($name)

=cut
sub getLookupMapQueryOrder {
	my ($self, $name) = @_;

	if (! defined $name) {
		$self->{error} = "Unable to get lookup map query order for undefined attribute";
		return undef;
	}
	elsif (! defined $self->{tables_lookup_list}->{$name}) {
		$self->{error} = "Attribute '$name' does not exist.";
		return undef;
	}
	
	return @{$self->{tables_lookup_list}->{$name}};
}

=head2 error ()

Returns last error accoured as string.

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

=head2 autoresponseActive ($addr)

Returns autoresponder activity status. Returns 1, if autoresponder is active for address $addr, and 0 if autoresponder is
inactive OR lookup error accoured. So, if you get result 0, be shure to check error() method result. if error() returns undef, autoresponder is disabled for address $addr.

=cut
sub autoresponseActive {
	my ($self, $addr) = @_;
	$self->{error} = undef;
	
	# check local domains
	return 0 unless ($self->inLocalDomains($addr));
	
	my $result = $self->getAutoresponseAttribute($addr, 'active');
	if (! defined $result) {
		if (defined $self->{error}) {
			$self->_logger("Error: Unable to get autoresponse activity status for address $addr: " . $self->{error});
			return 0;
		} else {
			$result = 0;
		}
	}

	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", autoresponseActive(), line ", __LINE__, ": lookup returned '$result'\n" if (DEBUG);

	$result = lc $result;
	
	return ($result eq '1' || $result eq 'y' || $result eq 'yes' || $result eq 't' || $result eq 'true');
}


=head2 getAutoresponseAttribute ($address, $name)

Queries lookup maps for autoresponse attribute named $name for address $address. Returns attribute
value as string or undef if lookup error accoured or attribute does not exist.

=cut
sub getAutoresponseAttribute {
	my ($self, $addr, $name) = @_;
	my $result_name;

	$self->{error} = undef;

	if (! defined $addr) {
		$self->{error} = "Unable to return value if no address is given.";
		return undef;
	}
	elsif (! defined $name) {
		$self->{error} = "Unable to return value of undefined autoresponse attribute.";
		return undef;
	}
	elsif (! defined $self->{tables_lookup_list}->{$name}) {
		$self->{error} = "Lookup table list is not defined for attribute '$name'.";
		$self->_logger("Error: Unable to retrieve autoresponse attribute '$name': " . $self->{error});
		return undef;
	}
	elsif (ref($self->{tables_lookup_list}->{$name}) ne 'ARRAY') {
		$self->{error} = "Invalid lookup table list for attribute '$name'.";
		$self->_logger("Error: Unable to retrieve autoresponse attribute '$name': " . $self->{error});
		return undef;
	}

	my $result = Yaa::LookupMap::Result->new;;

	foreach (@{$self->{tables_lookup_list}->{$name}}) {
		# is this a real lookup table?
		if (/$self->{_lookup_map_regex}/) {
			print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", getAutoresponseAttribute(), line ", __LINE__, ": '$_' is a lookup map.\n" if (DEBUG);
			$result_name = $2;
			if (! $self->_checkLookupMap($1)) {
				$self->_logger("Error: Unable to query lookup map '$1': " . $self->{error});
				return 0;
			}
			elsif (! defined ($result = $self->{_lookup_maps}->{$1}->lookup($addr))) {
				$self->{error} = "Lookup to map '$_' failed: " . $self->{_lookup_maps}->{$1}->error;
				$self->_logger("Error: Unable to query lookup map '$1': " . $self->{error});
				return 0;
			}
			
			last if ($result->getNumMatches());
		}
		# nope, it's just a string.
		else {
			print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", getAutoresponseAttribute(), line ", __LINE__, ": '$_' is just a string, it will become result of the current query.\n" if (DEBUG);
			$result->addMatch({result => $_});
			$result_name = 'result';
			last;
		}
	}
	
	# hm, let's do something with result
	return undef unless ($result->getNumMatches());
	$result->moveFirst();
	return $result->getMatchValueByKey($result_name);
}

=head2 inLocalDoains ($address)

Returns 1 if email address $address is part of local domains

=cut
sub inLocalDomains {
	my ($self, $addr) = @_;
	my $domain;
	
	unless (defined $addr) {
		$self->{error} = "No given address.";
		return 0;
	}
	elsif (ref($self->{tables_lookup_list}->{'local_domains'}) ne 'ARRAY') {
		$self->{error} = "Invalid lookup table list for attribute 'local_domains'.";
		$self->_logger("Error: " . $self->{error});
		return undef;
	}
	
	$addr = lc($addr);
	$domain = lc($1) if ($addr =~ m/^[\w\.\-]+@(.+)$/);

	foreach (@{$self->{tables_lookup_list}->{'local_domains'}}) {
		# is this a real lookup table?
		if (/$self->{_lookup_map_regex}/) {
			my $result_name = $2;
			my $result;
			if (! $self->_checkLookupMap($1)) {
				$self->_logger("Error: Unable to query lookup map '$1': " . $self->{error});
				return 0;
			}
			elsif (! defined ($result = $self->{_lookup_maps}->{$1}->lookup($addr))) {
				$self->{error} = "Lookup to map '$_' failed: " . $self->{_lookup_maps}->{$1}->error;
				$self->_logger("Error: Unable to query lookup map '$1': " . $self->{error});
				return 0;
			}
			
			return 1 if ($result->getNumMatches() > 0);
		}
		# nope, it's just a string.
		else {
			$_ = lc $_;
			return 1 if ($_ eq $addr || $_ eq $domain);
		}
	}

	return 0;
}

=head2 processMessageFile ($file)

Processes file $file containing single email message. Returns 1 on success, otherwise 0

=cut
sub processMessageFile {
	my ($self, $file) = @_;

	if (! defined $file) {
		$self->{error} = "Filename was not specified.";
		return 0;
	}
	elsif (my $fh = IO::File->new($file, 'r')) {
		my $result = $self->processMessageFh($fh);
		$fh = undef;
		return $result;
	}

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

=head2 processMessageFh ($filehandle)

Processes opened filehandle $filehandle opened to email message. Returns 1 on success, otherwise 0

=cut
sub processMessageFh {
	my ($self, $fh) = @_;
	
	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": startup.\n" if (DEBUG);
	
	# generate message id
	$self->{_msgid} = int(rand(9999999));
	$self->_logger("Processing new request, id " . $self->{_msgid});

	# check filehandle
	if (substr(ref($fh), 0, 4) ne 'IO::') {
		$self->{error} = "Invalid filehandle.";
		$self->_logger("Error: " . $self->{error});
		return 0;
	}
	# check for autoresponse object
	elsif (! defined $self->{_ar}) {
		$self->{error} = "Yaa::Autoresponse object not set.";
		$self->_logger("Error: " . $self->{error});
		return 0;
	}
	
	# create new message object inside autoresponse object if necessary, otherwise perform object cleanup
	if (defined $self->{_ar}->{msg}) {
		$self->{_ar}->{msg}->clearParams();
	} else {
		$self->{_ar}->{msg} = Yaa::Message->new();
	}
	
	# parse message
	unless ($self->{_ar}->{msg}->parseFh($fh)) {
		print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": message parsing failed: ", $self->{_ar}->{msg}->error, "\n" if (DEBUG);
		$self->{error} = "Unable to parse message: " . $self->{_ar}->{msg}->error;
		return 0;
	}
	
	# i'm coming up, i'm coming up,
	# let's get this party started right now :)
	
	my $sender;
	my @recipients;
	
	# hm. try to get sender and recipients addresses from from protocol handler, if we're running
	# in daemon mode
	my $proto_sender = $self->_getProtocolSender();
	my @proto_recipients = $self->_getProtocolRecipients();
	
	# manipulate sender and recipients, if necessary...
	if (defined $proto_sender && @proto_recipients) {
		print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": recipients extracted from protocol handler.\n" if (DEBUG);
		
		# rewrite sender address
		if (! defined ($sender = $self->_rewriteSender($proto_sender))) {
			$self->_logger("Error: Unable to rewrite sender address: " . $self->{error});
			return 0;
		}
		# rewrite recipient addresses
		if (! (@recipients = $self->_rewriteRecipient(@proto_recipients))) {
			$self->_logger("Error: Unable to rewrite recipient address(es): " . $self->{error});
			return 0;
		}
	} else {
		# get recipients from message
		my $tmp;
		
		# try to get non standard Delivered-To header
		if (! defined ($tmp = $self->{_ar}->{msg}->getHeader('Delivered-To'))) {
			$self->_logger("Warning: Your MTA does not provide Delivered-To header. Yaa will have to rely on message headers which are very easy to fake. You've been warned.");
			push(@recipients, $self->{_ar}->{msg}->getAllRecipients());
		} else {
			push(@recipients, $tmp);
		}

#		# try to get standard Return-Path header
#		if (! defined ($tmp = $self->{_ar}->{msg}->getHeader('Return-Path'))) {
#			$self->_logger("Warning: Your MTA violates RFC 822 by not adding Return-Path header in message. Yaa will have to rely on message headers which are very easy to fake. You've been warned.");
#			$sender = $self->{_ar}->{msg}->getSenderAddr();
#		} else {
#			$sender = $tmp;
#			$sender =~ s/[<>]//g;
#		}
		my $tmpSender = $self->_rewriteSender($self->{_ar}->{msg}->getSenderAddr());
		if(defined($tmpSender) && length($tmpSender)) {
			$sender = $tmpSender;
		}
		else {
			if (! defined ($tmp = $self->{_ar}->{msg}->getHeader('Return-Path'))) {
				$self->_logger("Warning: Your MTA violates RFC 822 by not adding Return-Path header in message. Yaa will have to rely on message headers which are very easy to fake. You've been warned.");
				$sender = $self->{_ar}->{msg}->getSenderAddr();
			}
			else {
				$sender = $tmp;
				$sender =~ s/[<>]//g;
			}
		}
	}
	
	# remove duplicates from recipients
	@recipients = remove_duplicates(@recipients);

	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": Message sender: ", $sender, "\n" if (DEBUG);
	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": Message recipients: ", join(", ", @recipients), "\n" if (DEBUG);
	$self->_logger("Message sender: $sender, recipients: " . join(", ", @recipients));
	
	# do not reply to special senders
	if (! defined $sender || ! length $sender) {
		$self->_logger("Autoresponse will not be sent to empty or undefined sender address.");
		return 1;
	}
	
	# check each and every recipients
	foreach my $recipient (@recipients) {
		print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": Checking recipient '$recipient'\n" if (DEBUG);
		
		# message must be parsed
		last if (! $self->{_ar}->{msg}->isParsed());
		
		# should we do something about this recipient?
		if (
			$recipient ne $sender &&										# recipient is not message sender
			! defined ($self->{_ar}->{msg}->getHeader('Auto-Submitted', 1)) &&	# this is not autoreply message
			! $self->{_ar}->{msg}->isMailingListPost() &&							# this is not mailing list post
			! $self->autoresponseActive($sender) &&							# vacation is not active for message sender
			$self->autoresponseActive($recipient)							# vacation is active for $recipient
		) {
			$self->_logger("Recipient " . $recipient . " has autoresponder turned on.");
			
			# time to send autoresponse; check timeframe
			if ($self->_timeframe($sender, $recipient)) {
				# send autoresponse
				print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", processMessageFh(), line ", __LINE__, ": Sending autoresponse to address '$sender' as sender '$recipient'\n" if (DEBUG);
				
				# set autoresponse properties
				$self->{_ar}->setParams(
					charset => $self->getAutoresponseAttribute($recipient, 'charset')
				);
				
				if ($self->{_ar}->sendAutoresponse(\ $self->getAutoresponseAttribute($recipient, 'message'), $self->getAutoresponseAttribute($recipient, 'subject'), $recipient, $sender)) {
					$self->_logger("Successfuly sent autoresponse from $recipient to $sender.");
					$self->_timeframeUpdate($sender, $recipient);
				} else {
					$self->{error} = "Sending autoresponse message failed: " . $self->{_ar}->error;
					$self->_logger("Error: " . $self->{error});
					return 0;
				}
				
			} else {
				$self->_logger("Auto response will not be sent to " . $sender . " as " . $recipient . " becouse last message was sent to this recipient less than " . $self->{tf_duration_interval} . " second(s) ago.");
			}
			
			my $forward = $self->getAutoresponseAttribute($recipient, 'forward');
			if (defined ($forward) && length $forward && ! $self->autoresponseActive($forward)) {
				if ($self->{_ar}->forwardMessage($recipient, $forward)) {
					$self->_logger("Successfuly forwarded message to '$forward' as '$recipient'.");
				} else {
					$self->_logger("Error forwarding message: " . $self->{_ar}->error);
				}
			}
		}
	}
	
	# log end of request
	$self->_logger("Processing complete.");

	return 1;
}


=head2 processMessage (\ $string)

Processes $string, which holds entire email message. Returns 1 on success, otherwise 0

=cut
sub processMessage {
	my ($self, $msg) = @_;

	# check message
	if (ref($msg) ne 'SCALAR') {
		$self->{error} = "Message not provided as scalar reference.";
		return 0;
	}
	elsif (my $fh = IO::Scalar->new($msg)) {
		my $result = $self->processMessageFh($fh);
		$fh = undef;
		return $result;
	}

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


=head2 processMessageByFileno ($fileno)

Processes opened filehandle defined by opened filedescriptor number. Returns 1 on success, otherwise 0.

=cut
sub processMessageByFileno {
	my ($self, $fileno) = @_;
	if (! defined $fileno) {
		$self->{error} = "File number was not specified.";
		return 0;
	}
	
	my $fh = IO::Handle->new;

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

	$self->{error} = "Cannot open filehandle on provided filedescriptor number.";
	return 0;
}

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

sub _getProtocolSender {
	return undef;	
}

sub _getProtocolRecipients {
	return undef;
}

sub _rewriteSender {
	my ($self, $addr) = @_;
	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", _rewriteSender(), line ", __LINE__, ": got sender address '$addr'\n" if (DEBUG);
	my $result = $self->getAutoresponseAttribute($addr, 'rewrite_sender');
	$result = $addr if (! defined $result);
	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", _rewriteSender(), line ", __LINE__, ": sender rewrite result: '$result\n" if (DEBUG);
	return $result;
}

sub _rewriteRecipient {
	my $self = shift;
	my @results;
	
	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", _rewriteRecipient(), line ", __LINE__, ": got recipients ", join(", ", @_), "\n" if (DEBUG);
	foreach (@_) {
		my $result = $self->getAutoresponseAttribute($_, 'rewrite_recipient');
		$result = $_ unless (defined $result);
		print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", _rewriteRecipient(), line ", __LINE__, ": rewrite result for address '$_' : '$result'\n" if (DEBUG);
		push(@results, $result);
	}

	print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", _rewriteRecipient(), line ", __LINE__, ": returning result array: ", join(", ", @results), "\n" if (DEBUG);	

	return @results;
}

sub _checkLookupMap {
	my ($self, $name) = @_;
	
	if (! defined $name) {
		$self->{error} = "Undefined lookup map name.";
		return 0;
	}
	elsif (! defined $self->{_lookup_maps}->{$name}) {
		$self->{error} = "Lookup map does not exist.";
		return 0;
	}
	
	return 1;
}


# logs something
sub _logger {
	my $self = shift;
	if (defined $self->{_log}) {
		return $self->{_log}->logger((($self->{_msgid}) ?  $self->{_msgid} . ": " : undef), @_);
	}
	return 0;
}

sub _timeframe ($) {
	my ($self, $sender, $recipient) = @_;
	my %h = ();
	my $autoreply_last_sent = undef;

	# in single process mode we can check this only
	# using DB_File
	if (! tie(%h, 'DB_File', $self->{db_dir} . '/yaa_timeframe.db', , O_RDWR|O_CREAT, 0600, $DB_BTREE)) {
		$self->_logger("Error: Cannot tie timeframe hash to " . $self->{db_dir} . '/yaa_timeframe.db');
		return 0;
	}

	my $key = $sender . "|" . $recipient;
	$autoreply_last_sent = ($h{$key}) ? $h{$key} : 0;

	untie %h;

	return(time() > ($autoreply_last_sent + $self->{tf_duration_interval}));
}

sub _timeframeUpdate {
	my ($self, $sender, $recipient) = @_;
	my %h = ();

	# in single process mode we can check this only
	# using DB_File
	if (! tie(%h, 'DB_File', $self->{db_dir} . '/yaa_timeframe.db' , O_RDWR|O_CREAT, 0600, $DB_BTREE)) {
		$self->_logger("Error: Cannot tie timeframe hash to " . $self->{db_dir} . '/yaa_timeframe.db');
		return 0;
	}

	my $key = $sender . "|" . $recipient;
	$h{$key} = time();
	untie %h;

	return 1;
}


####################################################
#               NON OO FUNCTIONS                   #
####################################################

sub trim {
	my $str = $_[0];
	$str =~ s/^\s+//;
	$str =~ s/\s+$//;

	return $str;
}

sub remove_duplicates {
	my %seen = ();
	return (grep { ! $seen{$_} ++ } @_);
}

1;

=head1 SEE ALSO

perldoc Yaa::LookupMap

perldoc Yaa::LookupMap::Driver::<USED_DRIVER>

perldoc Yaa::Autoresponse

perldoc Yaa::Log

For general MTA configuration see Yaa homepage:

http://frost.ath.cx/software/yaa

=cut

=head1 AUTHOR

Branko F. Gracnar <bfg@frost.ath.cx>
http://frost.ath.cx/~bfg

=cut

=head1 LICENSE

This software is released under BSD-style license. If you like this software, send me a nice postcard from somewhere to the snail mail address published on my website.

=cut

