package ot_execute;
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( &debug &mailerror &usermail &split_email_addr &split_addr );
use ot_dblib qw( &db_connect &db_disconnect &db_insert &db_delete
&db_select_col &db_select_row &db_select_val
&db_cursor_open &db_cursor_get &db_cursor_close &db_update_col
&db_insert_member &db_get_msg &db_get_mail_msg &db_set_status &db_get_projabb);
use vars qw(@ISA @EXPORT_OK $VERSION);
use Exporter;
$VERSION = 1.03;
@ISA = qw(Exporter);
@EXPORT_OK = qw( &execute );

=head1 NAME

ot_execute - executes all commands stored in table command

=head1 SYNOPSIS

Scans table 'command' and executes all commands.

=head1 DESCRIPTION

All functions and procedures are described below.

=head2 initmsg - initializes a msg hash, see &sendmsg

S<in-param:	variable parameter list as key-value-pairs
returns:	%msg - msg hash>

The msg hash is used to obtain a message from database. This message
might contain variables, which will be interpreted in given context.
Valid variables in the context are (not all of them are initialized
with every command!):
S<
+ $cmd: command
+ $proj: short project name
+ $projlow: $proj in lower cases
+ $fn: user's first name (only if mid exists)
+ $ln: user's last name (only if mid exists)
+ $email: user's email address (only if mid exists)
+ $pw: user's password (only if mid exists)
+ $long: user's long format email address (incl. alias)
+ $send: date of mail send by user
+ $subj: subject of mail send by user
+ $body: body of mail send by or to user
+ $domain: mail domain
+ $fqdomain: fully qualified domain
+ $text: multi purpose text>

=cut

sub initmsg {
	my %msg = (
		mid	=> 0,	# member id
		proj	=> '',	# short project name
		from	=> '',	# sender (if empty: listmaster)
		long	=> '',	# long address
		addr	=> '',	# comma separated short address list
		send	=> '',	# date of user mail
		subj	=> '',	# subject of user mail
		rply	=> '',	# reply-to string
		cmd	=> '',	# command name
		text	=> '',	# multi purpose text
		body	=> '',	# body of user mail or for user mail
		@_,		# list of variable key-value-pairs
	);			# overwriting initial values
	return( %msg );
}

=head2 sendmsg - sends a user mail, msg is read from db

S<in-param:	$dbh - database handle
in-param:	$msg_id - message id, used to read msg from db
in-param:	$msgvar - variables for msg to interpret
returns:	$status - processing status>

=cut

sub sendmsg {
	my( $dbh, $msg_id, %msgvar ) = @_;
	my $mid = defined ($msgvar{mid}) ? $msgvar{mid} : '';
	my $proj = defined ($msgvar{proj}) ? $msgvar{proj} : '';
	my $from = defined ($msgvar{from}) ? $msgvar{from} : '';
	my $long = defined ($msgvar{long}) ? $msgvar{long} : '';
	my $addr = defined ($msgvar{addr}) ? $msgvar{addr} : '';
	my $send = defined ($msgvar{send}) ? $msgvar{send} : '';
	my $subj = defined ($msgvar{subj}) ? $msgvar{subj} : '';
	my $rply = defined ($msgvar{rply}) ? $msgvar{rply} : '';
	my $cmd = defined ($msgvar{cmd}) ? $msgvar{cmd} : '';
	my $text = defined ($msgvar{text}) ? $msgvar{text} : '';
	my $body = defined ($msgvar{body}) ? $msgvar{body} : '';
	my $domain = $ot{maildom};
	my $fqdomain = $ot{fqdomain};
	my $projlow = $proj;
	$projlow =~ tr/[A-Z]/[a-z]/; 
	my( $fn, $ln, $email, $pw, $msg, $alias ) = ( '', '', '', '', '' );

	if( $mid ){			# read user context if mid is not 0
		my %rec = db_select_row( $dbh, 'member',
			'first_n, last_n, email, passwd',			# fields
			"memb_id = $mid"					# where
		);
		if( !exists( $rec{email} )) { mailerror( 'Fatal error in ot_execute.send' ); }
		$fn = $rec{first_n};
		$ln = $rec{last_n};
		$email = $rec{email};
		$pw = $rec{passwd};
		$long = qq("$fn $ln" <$email>);
	} elsif( $addr ) {		# take address list if present
		$email = $addr;
	} else {			# otherwise use long address
		( $email, $alias ) = split_email_addr( $long );
		( $fn, $ln ) = split_addr( $alias, $email );
	}
	if( !( $_ = db_get_mail_msg( $dbh, $msg_id, 'de' ))) {
		mailerror( "ot_execute.sendmsg: missing msg" );
		return( $r{error} );
	}
	debug( "msg: $_", 1 );
	s/"/\\"/g;
	if( /(.+)%(.+)/ ){			# '%' is delimiter of subject%msg
		$subj = eval qq( "$1" );	# interpret in context!
		if( $@ ) { mailerror( "Error in eval 1: $@" ); }
		$_ = $2;
	}
	$msg = eval qq( "$_" );		# interpret in context!
	if( $@ ) { mailerror( "Error in eval 2: $@" ); }
	debug( "send - msg: $msg", 2 );
	usermail( $from, $long, $email, $subj, $rply, $msg );
	return( $r{ok_finished} );
}

=head2 which - sends a list with alls project of a member

S<in-param:	$dbh - database handle
in-param:	$mid _ member id
returns:	$status - processing status>

=cut

sub which {
	my( $dbh, $mid ) = @_;
	debug( "which: mid: $mid", 1 );
	my $status = $r{error};
	my %msg = db_get_msg( $dbh, 10, 'de' );
	my %val = ();
	my( $txt, $st )= ( '', '' );
	my $i = 0;
	my $cur = db_cursor_open( $dbh,
		'metatext m, projmemb p',						# tables
		'm.title, m.titlabb, m.vers_id, m.status, p.ismaint',			# cols
		"p.proj_id = m.proj_id and p.memb_id = $mid and m.status <> 'arc'"	# where
	);
	my $res = 1;
	while( $res ) {
		%val = db_cursor_get( $cur );
		$res = exists( $val{titlabb} );
		if( $res ){
			if( $val{status} eq 'act' ) { $st = $msg{71}; }
			elsif( $val{status} eq 'ini' ) { $st = $msg{72}; }
			elsif( $val{status} eq 'fin' ) { $st = $msg{73}; }
			#$st =~ tr/[A-Z]/[a-z]/;
			$txt .= "- $msg{1} '$val{titlabb}'";
			if( $val{ismaint} ) { $txt .= " ($msg{4}!)"; }
			$txt .= ":\n  $val{title}\n";
			$txt .= "  $msg{74} $val{vers_id}, $msg{3}: $st\n\n";
			$i++;
		}
	}
	db_cursor_close( $cur );
	$txt .= "$i";
	my %msgvar = initmsg( mid => $mid, body => $txt );
	$status = sendmsg( $dbh, 106, %msgvar );
	return( $status );
}

=head2 who - sends a list with all members of a project

S<in-param:	$dbh - database handle
in-param:	$pid - project id
in-param:	$mid _ member id
returns:	$status - processing status>

=cut

sub who {
	my( $dbh, $pid, $mid ) = @_;
	debug( "who: pid: $pid, mid: $mid", 1 );
	my $status = $r{error};
	my %val = ();
	my $txt = '';
	my $i = 0;
	my $pjn = db_get_projabb( $dbh, $pid );
	my $cur = db_cursor_open( $dbh,
		'member m, projmemb p',				# tables
		'm.first_n, m.last_n, m.email',			# cols
		"p.memb_id = m.memb_id and p.proj_id = $pid"	# where
	);
	my $res = 1;
	while( $res ) {
		%val = db_cursor_get( $cur );
		$res = exists( $val{email} );
		if( $res ){
			$txt .= "$val{first_n} $val{last_n} <$val{email}>\n";
			$i++;
		}
	}
	db_cursor_close( $cur );
	$txt .= "\n$i";
	my %msgvar = initmsg( mid => $mid, proj => $pjn, body => $txt );
	$status = sendmsg( $dbh, 107, %msgvar );
	return( $status );
}

=head2 subscribe - subscribes a member and adds a project

S<in-param:	$dbh - database handle
in-param:	$pid - project id
in-param:	$mid - member Id (0, if not a ot-member)
in-param:	$arg - argument (values)
returns:	$status - processing status>

=cut

sub subscribe {
	my( $dbh, $pid, $mid, $arg ) = @_;
	debug( "subscribe: pid: $pid, mid: $mid, arg: $arg", 1 );
	my $status = $r{error};
	my %rec;
	if( !$mid ) {
		my( $addr, $alias ) = split_email_addr( $arg );
		my( $fn, $ln ) = split_addr( $alias, $addr );
		my $pw = int( rand( 1000000 ));
		%rec = (
			last_n	=> $ln,
			first_n	=> $fn,
			email	=> $addr,
			passwd	=> $pw			);
		$mid = db_insert_member( $dbh, %rec );
		my %msgvar = initmsg( mid => $mid, text => $pw );
		$status = sendmsg( $dbh, 102, %msgvar );
	}
	if( !is_err( $mid ) && ( $pid > 0 )) {
		%rec = (
			proj_id	=> $pid,
			memb_id	=> $mid
		);
		if( db_insert( $dbh, 'projmemb', %rec )) {
			my $pjn = db_get_projabb( $dbh, $pid );
			my %msgvar = initmsg( mid => $mid, proj => $pjn );
			$status = sendmsg( $dbh, 104, %msgvar );
		}
	}
	return( $status );
}

=head2 unsubscribe - unsubscribes a member from a project

S<in-param:	$dbh - database handle
in-param:	$pid - project id
in-param:	$mid - member Id
returns:	$status - processing status>

=cut

sub unsubscribe {
	my( $dbh, $pid, $mid ) = @_;
	debug( "unsubscribe: pid: $pid, mid: $mid", 1 );
	my $status = $r{error};
	if( $pid < 0 ){
		my %rec = db_select_row( $dbh, 'member',
			'first_n, last_n, email',			# fields
			"memb_id = $mid"				# where
		);
		if( !exists( $rec{email} )) { mailerror( 'Fatal error in ot_execute.unsubscribe' ); }
		my $long = qq("$rec{first_n} $rec{last_n}" <$rec{email}>);
		if( db_delete( $dbh, 'member', "memb_id = $mid" )) {
			my %msgvar = initmsg( long => $long );
			$status = sendmsg( $dbh, 103, %msgvar );
		}
	}
	elsif( db_delete( $dbh, 'projmemb', "proj_id = $pid and memb_id = $mid" )) {
		my $pjn = db_get_projabb( $dbh, $pid );
		my %msgvar = initmsg( mid => $mid, proj => $pjn );
		$status = sendmsg( $dbh, 105, %msgvar );
	}
	return( $status );
}

=head2 confirm - confirmes a command

S<in-param:	$dbh - database handle
in-param:	$arg - argument (values)
returns:	$status - processing status>

=cut

sub confirm {
	my( $dbh, $arg ) = @_;
	debug( "confirm: arg: $arg", 1 );
	my $status = $r{nothing_confirm};
	$_ = $arg;
	/(.+)\.(\d+)\Z/;
	if( $1 && $2 ){
		my $qry = "cmdkey = '$1' and cmd_id = $2";
		if( db_select_val( $dbh, 'command', 'cmd_id', $qry )) {
			$status = $r{ok_confirmed};
			db_set_status( $dbh, $2, $status );
		}
	}
	return( $status );
}

=head2 maillist - send an mail to mailinglist

S<in-param:	$dbh - database handle
in-param:	$rid - id of the receive record
in-param:	$pid - project id
in-param:	$arg - argument (values)
returns:	$status - processing status>

=cut

sub maillist {
	my( $dbh, $rid, $pid, $arg ) = @_;
	debug( "maillist: rid: $rid, pid: $pid, arg: arg", 1 );
	my $status = $r{error};
	if( $pid == 0 ) { return( $status ); };
	my $mlst = db_select_val( $dbh, 'metatext',
		'maillst',
		"proj_id = $pid and ( status = 'act' or status = 'fin' )"
	);
	debug( "maillist - mlst: $mlst", 1 );
	if( !( $mlst )) {
		mailerror( "ot_execute.maillist: empty mailinglist" );
		return( $r{error} );
	}
	my $whr = "m.memb_id = p.memb_id and p.proj_id = x.proj_id ";
	$whr .= "and x.maillst = '$mlst' and m.bounce < 5";
	my @mailaddr = db_select_col( $dbh,
		'member m, projmemb p, metatext x',		# tables
		'distinct m.email',				# column
		$whr						# where
	);
	my $curr_email = join( ', ', @mailaddr );
	debug( "maillist-Adressen: $#mailaddr: $curr_email", 1 );
	my %r = db_select_row( $dbh, 'receive',			# table
		'proj_addr, addr_to, addr_cc, subject, sender',	# fields
		"rec_id = $rid"					# where
	);
	my $long = $r{addr_to};
	if( $r{addr_cc} ) { $long .= "\nCc: ".$r{addr_cc}; }
	my $subj = "[ot:$r{proj_addr}] $r{subject}";
	my $from = $r{sender};
	my %msgvar = initmsg(
		from => $from,
		addr => $curr_email,
		long => $long,
		subj => $subj,
		rply => $mlst,
		body => $arg
	);
	$status = sendmsg( $dbh, 100, %msgvar );
	return( $status );
}

=head2 eval_command - evaluates and executes a command

S<in-param:	$dbh - database handle
in-param:	$rid - id of the receive record
in-param:	$cid - id of the command record
in-param:	$pid - project id
in-param:	$mid - member Id (0, if not a ot-member)
in-param:	$cmd - command
in-param:	$arg - argument (values)
returns:	$status - processing status>

=cut

sub eval_command {
	my( $dbh, $rid, $cid, $pid, $mid, $cmd, $arg ) = @_;
	my $status = $r{error};
	my %rec;
	debug( "eval_command: rid: $rid, cid: $cid, pid: $pid, mid: $mid, cmd: $cmd, arg: arg", 1 );

	# commands without arguments:
	# which, who, subscribe, unsubscribe, gettree, getlists
	if( is( $cmd, $f{no_arg} )) {
		$_ = $cmd;
		if( /which/ ){
			$status = which( $dbh, $mid );
		}
		elsif( /who/ ){
			$status = who( $dbh, $pid, $mid );
		}
		elsif( /unsubscribe/ ){
			$status = unsubscribe( $dbh, $pid, $mid );
		}
		elsif( /subscribe/ ){
			$status = subscribe( $dbh, $pid, $mid, $arg );
		}
		elsif( /getlists/ ){
		}
		elsif( /gettree/ ){
		}
	}

	# commands with one argument:
	# confirm, help, submit, give, addsub, uselist, keywords, title, description
	elsif( is( $cmd, $f{one_arg} )) {
		$_ = $cmd;
		if( /addsub/ ){
		}
		elsif( /confirm/ ){
			$status = confirm( $dbh, $arg );
		}
		elsif( /description/ ){
		}
		elsif( /give/ ){
		}
		elsif( /help/ ){
		}
		elsif( /keywords/ ){
		}
		elsif( /submit/ ){
		}
		elsif( /title/ ){
		}
		elsif( /uselist/ ){
		}
	}

	# commands with two arguments:
	# setoption, comment, setname, newversion
	elsif( is( $cmd, $f{two_args} )) {
		$_ = $cmd;
		if( /setoption/ ){
		}
		elsif( /comment/ ){
		}
		elsif( /setname/ ){
		}
		elsif( /newversion/ ){
		}
		elsif( /maillist/ ){
			$status = maillist( $dbh, $rid, $pid, $arg );
		}
	}

	# commands with three arguments:
	# newproject
	elsif( is( $cmd, $f{three_args} )) {
		$_ = $cmd;
		if( /newproject/ ){
		}
	}

	if( $status == $r{ok_confirmed} ){	# if a cmd was confirmed: execute cmd
		$status = $r{nothing_confirm};
		$_ = $arg;
		/.+\.(\d+)\Z/;
		if( $1 ) {
			%rec = db_select_row( $dbh,
			'receive r, command c',					# tables
			'r.rec_id, r.proj_id, r.memb_id, c.cmdkey, c.cmdval',	# fields
			"r.rec_id = c.rec_id and c.cmd_id = $1
			and c.stcode = $r{ok_confirmed}"			# where
			);
			if( exists( $rec{proj_id} )) {
				$status = eval_command( $dbh, $rec{rec_id}, $1, $rec{proj_id},
					$rec{memb_id}, $rec{cmdkey}, $rec{cmdval} );
			}
		}
	}

	db_set_status( $dbh, $cid, $status );
	return( $status );
}

=head2 send_confirm - sends a mail to user to confirm a command

S<in-param:	$dbh - database handle
in-param:	$cid - id of the command record
in-param:	$long - sender's long address
in-param:	$send - date of user mail
in_param:	$subj - subject of user mail
in-param:	$cmd - command
returns:	$status - processing status>

=cut

sub send_confirm {
	my( $dbh, $cid, $long, $send, $subj, $cmd ) = @_;
	my $status = $r{ok_requested};
	debug( "send_confirm: cid: $cid, long: $long, send: $send, subj: $subj, cmd: $cmd", 1 );
	my %msgvar = initmsg(
		long => $long,
		send => $send,
		subj => $subj,
		rply => "confirm*$cmd.$cid\@$ot{maildom}",
		cmd => $cmd
	);
	sendmsg( $dbh, 101, %msgvar );
	db_set_status( $dbh, $cid, $status );
	return( $status );
}

=head2 eval_error - evaluates an error and sends an user reply

S<in-param:	$dbh - database handle
in-param:	$cid - id of the command record
in-param:	$long - sender's long address
in_param:	$send - date of user mail
in_param:	$subj - subject of user mail
in-param:	$cmd - command
in-param:	$body - mail body of user mail
in-param:	$stc - status code of prior evaluation
returns:	$status - processing status>

=cut

sub eval_error {
	my( $dbh, $cid, $pid, $long, $send, $subj, $cmd, $val, $body, $stc ) = @_;
	my $status = $r{ok_finished};
	my $pjn = '';
	if( $pid ) { $pjn = db_get_projabb( $dbh, $pid ); }
	debug( "eval_error: long: $long, subj: $subj, stc: $stc", 1 );
	my %msgvar = initmsg(
		long => $long,
		send => $send,
		subj => $subj,
		cmd => $cmd,
		proj => $pjn,
		text => $val,
		body => $body
	);
	sendmsg( $dbh, $stc, %msgvar );
	db_set_status( $dbh, $cid, $status );
	return( $status );
}

=head2 execute - executes all commands

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

=cut

sub execute {
	debug( "##### Start execute: ".localtime, 0 );
	my( $msg_id ) = @_;
	my $status = $r{ok};
	my $dbh = db_connect;	# database handle
	my @rlist = db_select_col( $dbh, 'receive', 'rec_id', "msg_id = '$msg_id'" );
	my @clist = ();
	my @t = ();
	my $rec_id;
	my $cmd_id;
	my %x;

	foreach $rec_id ( @rlist ) {
		@t = db_select_col( $dbh, 'command', 'cmd_id', "rec_id = $rec_id" );
		push( @clist, @t );
	}

	# first: send confirm
	foreach $cmd_id ( @clist ){
		%x = db_select_row( $dbh,
			'receive r, command c',						# tables
			'r.sender, r.send, r.subject, c.cmdkey',			# fields
			"r.rec_id = c.rec_id and c.cmd_id = $cmd_id
			and c.stcode = $r{ok_to_confirm}"				# where
		);
		if( exists( $x{sender} )) {
			$status = send_confirm( $dbh, $cmd_id, $x{sender}, $x{send},
				$x{subject}, $x{cmdkey} );
		}
	}

	# second: evaluate all commands
	foreach $cmd_id ( @clist ){
		%x = db_select_row( $dbh,
			'receive r, command c',						# tables
			'r.rec_id, r.proj_id, r.memb_id, c.cmdkey, c.cmdval',		# fields
			"r.rec_id = c.rec_id and c.cmd_id = $cmd_id
			and c.stcode >= $r{ok} and c.stcode < $r{ok_finished}"		# where
		);
		if( exists( $x{proj_id} )) {
			$status = eval_command( $dbh, $x{rec_id}, $cmd_id,
				$x{proj_id}, $x{memb_id}, $x{cmdkey}, $x{cmdval} );
		}
	}

	# third: evaluate all execute errors
	foreach $cmd_id ( @clist ){
		%x = db_select_row( $dbh,
			'receive r, command c',						# tables
			'r.proj_id, r.sender, r.send, r.subject, r.body, c.stcode, c.cmdkey, c.cmdval',	# fields
			"r.rec_id = c.rec_id and c.cmd_id = $cmd_id
			and c.stcode < $r{errors}"					# where
		);
		if( exists( $x{sender} )) {
			$status = eval_error( $dbh, $cmd_id, $x{proj_id}, $x{sender}, $x{send},
				$x{subject}, $x{cmdkey}, $x{cmdval}, $x{body}, $x{stcode} );
		}
	}

	# fourth: delete all finished commands
	my $r = 0;
	@rlist = db_select_col( $dbh, 'command', 'rec_id', "stcode = $r{ok_finished}" );
	if( !db_delete( $dbh, 'command', "stcode = $r{ok_finished}" )) {last;}
	foreach $rec_id ( sort @rlist ) {
		if( $r != $rec_id ) {
			@t = db_select_col( $dbh, 'command', 'cmd_id', "rec_id = $rec_id" );
			if( $#t < 0 ) {
				if( !db_delete( $dbh, 'receive', "rec_id = $rec_id" )) {last;}
			}
		}
		$r = $rec_id;
	}

	db_disconnect( $dbh );
	return( $status );
}
1;
