package ot_parse_a;
use strict;
use FindBin;
use lib $FindBin::Bin;
#use lib '/data/httpd/lib/perl';
use ot_const qw( %ot %r %f &is &is_err );
use ot_maillib qw( &mail &debug &mailerror &usermail &split_email_addr
&format_body );
use ot_dblib qw( &db_connect &db_disconnect &db_insert_cmd &db_select_col
&db_select_row &db_set_rec_pid &db_maillist_pid
&db_is_project &db_set_status );
use vars qw(@ISA @EXPORT_OK $VERSION);
use Exporter;
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT_OK = qw(&parse);

=head1 NAME

ot_parse_a - parses mails for address based commands

=head1 SYNOPSIS

Mails in address based mode are parsed, validated with some simple
checks and stored in the database.

=head1 DESCRIPTION

All functions ands procedures are described below.

=head2 &write_command - analyses and writes command to database

S<in-param:	$dbh - database handle
in-param:	$rec_id - id of the receive record
in-param:	$proj_addr - command and evt. projectname
in-param:	$sender - sender's long format address
in-param:	$body - mail body
returns:	$status - processing status>

=cut

sub write_command {
	my( $dbh, $rec_id, $proj_addr, $sender, $body ) = @_;
	my $status = $r{ok};
	my( $arg, $pjn ) = ( '', '' );
	my $cmd_id = int( rand( 1000000000 ));
	my( $p, $pid ) = ( 0, 0 );
	my $cmd = $proj_addr;
	$_ = $cmd;
	if( /(.+)\*(.*)/ ){
		$cmd = $1;
		$arg = $2;
	} else {			# might be a simple mailinglist mail
		$arg = $cmd;		# listname=projname is arg (to check)
		$cmd = 'maillist';	# command is set here
	}
	debug( "Command: $cmd, Proj/Arg: $arg", 2 );

	# validate command
	if( !is_err( $status ) && !is( $cmd, $f{valid_command} )) {
		$status = $r{invalid_command};
	}

	# check for projectname, if necessary, validate and update table receive
	if( !is_err( $status ) && is( $cmd, $f{has_pj_name} )) {
		if( $arg eq '' ) { $status = $r{missing_pjname}; }
		else {
			if( $cmd eq 'command' ) {
				$_ = $arg;
				/(.+)\.[\d\.]+/i;
				$pjn = $1;
			} else {
				$pjn = $arg;
			}
			if( !($pid = db_is_project( $dbh, $pjn ))){
				$status = $r{invalid_pjname};
			} else {
				db_set_rec_pid( $dbh, $rec_id, $pid );
			}
		}
	}

	if( !is_err( $status )) {

		# commands without arguments (having proj_id in receive!):
		# which, who, subscribe, unsubscribe, gettree, getlists
		if( is( $cmd, $f{no_arg} )) {
			$_ = $cmd;
			if( /subscribe/ ) {
				$arg = $sender;
			}
		}
		# commands with one argument (having proj_id in receive!):
		# confirm, help, submit, give, addsub, uselist, keywords, title, description
		if( is( $cmd, $f{one_arg} )) {
			$_ = $cmd;
			if( /submit|give|addsub|uselist|keywords|title|description/ ){
				$arg = format_body( $body );
			}
#			else { $status = $r{sh_never_happen}; }
		}
		# commands with two arguments (having proj_id in receive!)
		# setoption, comment, setname, newversion, maillist
		elsif( is( $cmd, $f{two_args} )) {
			$_ = $cmd;
			if( /setoption/ ) {
				$arg =~ s/\./\n/;	# replace dot with newline
			}
			elsif( /comment.+/ ) {
				$_ = $arg;
				/comment\.(.+)/;
				$arg = "$1\n$body";	# append comment to paranum
			}
			elsif( /setname/ ) {
				$arg =~ s/\s/\n/;	# replace first whitespace with newline
			}
			elsif( /newversion/ ) {
				$arg = $body;		# body should be in correct format
			}
			elsif( /maillist/ ) {
				$arg = $body;
				if( !( $p = db_maillist_pid( $dbh, $pid ))) {
					$status = $r{error};
					mailerror( "ot_parse_a.write_command.maillist: mailing list error: $pid" );
				} elsif( $p != $pid ) {
					db_set_rec_pid( $dbh, $rec_id, $p );
				}
			}
			else { $status = $r{sh_never_happen}; }
		}
		# commands with three arguments (having proj_id in receive!)
		# newproject
		elsif( is( $cmd, $f{three_args} )) {
			$_ = $cmd;
			if( /newproject/ ){
				$arg = $body;		# body should be in correct format
			}
			else { $status = $r{sh_never_happen}; }
		}
	}
	
	$arg =~ s/(['"])/\\$1/g;	# backslash quotes
	db_insert_cmd( $dbh, $rec_id, $cmd_id, 1, $cmd, $arg );
	if( is_err( $status )) { db_set_status( $dbh, $cmd_id, $status ); }
	return( $status );
}

=head2 parse - parses mail from db

S<in-param:	$msg_id - message id
returns:	status>

=cut

sub parse {
	debug( "##### Start parse: ".localtime, 0 );
	my( $msg_id ) = @_;
	my $status = $r{error};
	my $dbh = db_connect;	# database handle
	my @idlist = db_select_col( $dbh, 'receive', 'rec_id', "msg_id = '$msg_id'" );
	my %rec;
	foreach my $x ( @idlist ){debug( "receive.rec_id ist $x", 2 );}
	foreach my $rec_id ( @idlist ){
		%rec = db_select_row( $dbh, 'receive', "proj_addr, sender, body", "rec_id = $rec_id" );
#		foreach my $x ( keys %rec ){debug( ">>$x: ".$rec{$x}, 2 );}
		$status = write_command( $dbh, $rec_id, $rec{proj_addr}, $rec{sender}, $rec{body} );
	}
	db_disconnect( $dbh );
	return( $status );
}
1;
