package ot_dblib;
use strict;
use DBI;
use FindBin;
use lib $FindBin::Bin;
#use lib '/data/httpd/lib/perl';
use ot_const qw( %ot &res );
use ot_maillib qw( &debug );
use vars qw( @ISA @EXPORT_OK $VERSION );
use Exporter;
$VERSION = 1.01;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
&db_connect
&db_disconnect
&db_count
&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_receive
&db_insert_member
&db_pj_member
&db_is_member
&db_is_maintainer
&db_has_maillist
&db_maillist_pid
&db_is_project
&db_get_memb_id
&db_set_rec_pid
&db_set_status
&db_get_msg
&db_get_mail_msg
&db_get_projabb
&db_insert_cmd
);

=head1 NAME

	ot_dblib - open theory database interface

=head1 SYNOPSIS

	The ot_dblib provide database functions for open theory.

=head1 DESCRIPTION

	All functions are described in the following.

=head2 &db_connect - connects to database

in-param:	--                                                     .
returns:	$dbh - database handle

=cut

sub db_connect {
	my $s = 'DBI:mysql:database='.$ot{sqldb}.';host='.$ot{sqlhost};
	my $dbh = DBI->connect( $s, $ot{sqluser}, $ot{sqlpw}, {RaiseError=>1} );
	return( $dbh );
}

=head2 &db_disconnect - disconnects from database

in-param:	$dbh - database handle
returns:	--

=cut

sub db_disconnect {
	my( $dbh ) = @_;
	$dbh->disconnect;
}

=head2 &db_count - counts entries in a table

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$whr - where condition
returns:	$num - number of entries found

=cut

sub db_count {
	my( $dbh, $tbl, $whr ) = @_;
	my $qry = $dbh->prepare( "select count(*) as n from $tbl where $whr" );
	if( !$qry->execute()) { return( 0 ); }
	my $row = $qry->fetchrow_hashref();
	return( $row->{'n'} );
}

=head2 &db_insert - inserts one record into a table

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	%rec - record of column-value-pairs
returns:	$res - result (TRUE/FALSE)

=cut

sub db_insert {
	my( $dbh, $tbl, %rec ) = @_;
	my $q1 = '';
	my $q2 = '';
	foreach my $col ( keys %rec ) {
		if( $q1 ) { $q1 .= ', '; $q2 .= ', '; }
		$q1 .= "$col";
		$q2 .= "'$rec{$col}'";
	}
	debug( "insert into $tbl ( $q1 ) values ( $q2 )", 1 ); ######
	my $qry = $dbh->prepare( "insert into $tbl ( $q1 ) values ( $q2 )" );
	my $res = $qry->execute();
	return( $res );
}

=head2 &db_delete - deletes all records from table using where condition

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$whr - where condition
returns:	$res - result (TRUE/FALSE)

=cut

sub db_delete {
	my( $dbh, $tbl, $whr ) = @_;
	debug( "delete from $tbl where $whr", 1 ); ##########
	my $qry = $dbh->prepare( "delete from $tbl where $whr" );
	my $res = $qry->execute();
	return( $res );
}

=head2 &db_select_col - selects all records of one column of the table

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$col - column
in-param:	$whr - where condition
returns:	@val - array of result values

=cut

sub db_select_col {
	my( $dbh, $tbl, $col, $whr ) = @_;
	my @val = ();
	my $rw;
	debug( "select $col from $tbl where $whr", 1 ); ####
	my $qry = $dbh->prepare( "select $col from $tbl where $whr" );
	if( $qry->execute()) {
#		while( $rw = $qry->fetchrow_hashref() ) {
		while(( $rw  ) = $qry->fetchrow_array ) {
#			push( @val, $rw->{$col} );
			push( @val, $rw );
		}
		$qry->finish();
	}
	return( @val );
}

=head2 &db_select_row - selects one record (all columns) from table

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$cols - column list
in-param:	$whr - where condition
returns:	%val - hash of field-value-pairs

=cut

sub db_select_row {
	my( $dbh, $tbl, $cols, $whr ) = @_;
	my %val = ();
	my $rw;
	debug( "select $cols from $tbl where $whr", 1 );	
	my $qry = $dbh->prepare( "select $cols from $tbl where $whr" );	
	if( $qry->execute() && ( $rw = $qry->fetchrow_hashref())) {
		%val = %$rw;
		if( $qry->fetchrow_hashref()) {
			debug( "db_select_row: too many rows.\nQry: select $cols from $tbl where $whr", 0 );
		}	
	}
	$qry->finish();
	return( %val );
}

=head2 &db_select_val - selects a single value of a column of the table

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$col - column
in-param:	$whr - where condition
returns:	$val - single result value (true), or false

=cut

sub db_select_val {
	my( $dbh, $tbl, $col, $whr ) = @_;
	my $val = '';
	my $rw;
	debug( "select $col from $tbl where $whr", 1 ); ####
	my $qry = $dbh->prepare( "select $col from $tbl where $whr" );
	if( $qry->execute() && ( $rw = $qry->fetchrow_hashref())) {
		$val = $rw->{$col};
		if( $qry->fetchrow_hashref()) {
			debug( "db_select_val: too many rows.\nQry: select $col from $tbl where $whr", 0 );
		}	
	}
	$qry->finish();
	return( $val );
}

=head2 &db_cursor_open - opens a cursor for table using where condition

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$cols - column list
in-param:	$whr - where condition
returns:	%val - hash of field-arrayref-pairs

=cut

sub db_cursor_open {
	my( $dbh, $tbl, $cols, $whr ) = @_;
	debug( "cursor open: select $cols from $tbl where $whr", 1 );
	my $qry = $dbh->prepare( "select $cols from $tbl where $whr" );	
	if( $qry->execute()){ return( $qry ); }
	return( 0 );	
}

=head2 &db_cursor_get - gets a row from cursor

in-param:	$cur - cursor
returns:	%val - hash of field-arrayref-pairs

=cut

sub db_cursor_get {
	my( $cur ) = @_;
	my %val = ();
	if( my $row = $cur->fetchrow_hashref()){
		%val = %$row;
	}
	return( %val );
}

=head2 &db_cursor_close - closes the cursor

in-param:	$cur - cursor
returns:	-                                                  .

=cut

sub db_cursor_close {
	my( $cur ) = @_;
	$cur->finish();
}

=head2 &db_update_col - updates all records on one column of the table

in-param:	$dbh - database handle
in-param:	$tbl - tablename
in-param:	$col - column
in-param:	$val - new value
in-param:	$whr - where condition
returns:	$res - true/false

=cut

sub db_update_col {
	my( $dbh, $tbl, $col, $val, $whr ) = @_;
	my @val = ();
	my $rw;
	debug( "update $tbl set $col = '$val' where $whr", 1 );
	my $qry = $dbh->prepare( "update $tbl set $col = '$val' where $whr" );
	my $res = $qry->execute();
	return( $res );
}

=head2 &db_insert_receive - inserts a received email

in-param:	$dbh - database handle
in-param:	%rec - receive record hash
returns:	$rid - record id or, in error case, false

=cut

sub db_insert_receive {
	my( $dbh, %rec ) = @_;
	my $rid = 0;
	if( db_insert( $dbh, 'receive', %rec )) {
		$rid = db_select_val( $dbh, 'receive', 'rec_id', "msg_id = '$rec{msg_id}'" );	
	}
	return( $rid );
}

=head2 &db_insert_member - inserts an open theory member

in-param:	$dbh - database handle
in-param:	%rec - member record hash
returns:	$mid - member id or, in error case, false

=cut

sub db_insert_member {
	my( $dbh, %rec ) = @_;
	my $mid = 0;
	if( db_insert( $dbh, 'member', %rec )){
		$mid = db_select_val( $dbh, 'member', 'memb_id', "email = '$rec{email}'" );	
	}
	return( $mid );
}

=head2 &db_pj_member - check for membership in any project

in-param:	$dbh - database handle
in-param:	$mid - member id
returns:	True ($pid) / False (0)

=cut

sub db_pj_member {
	my( $dbh, $mid ) = @_;
	my @r = db_select_col( $dbh, 'projmemb', 'proj_id', "memb_id = '$mid'" );
	return( $#r >= 0 );
}

=head2 &db_is_member - check for membership in a given project

in-param:	$dbh - database handle
in-param:	$pid - project id
in-param:	$mid - member id
returns:	True ($pid) / False (0)

=cut

sub db_is_member {
	my( $dbh, $pid, $mid ) = @_;
	$pid = db_select_val( $dbh, 'projmemb', 'proj_id',
		"proj_id = '$pid' and memb_id = '$mid'" );
	return( $pid );
}

=head2 &db_is_maintainer - check for maintainership

in-param:	$dbh - database handle
in-param:	$pid - project id
in-param:	$mid - member id
returns:	true ($pid) / false (0)

=cut

sub db_is_maintainer {
	my( $dbh, $pid, $mid ) = @_;
	$pid = db_select_val( $dbh, 'metatext', 'proj_id',
		"proj_id = '$pid' and memb_id = '$mid'" );
	return( $pid );
}

=head2 &db_has_maillist - check if user has mailinglist

in-param:	$dbh - database handle
in-param:	$pid - project id
in-param:	$mid - member id
returns:	true/false

=cut

sub db_has_maillist {
	my( $dbh, $pid, $mid ) = @_;
	my $res = 0;
	my $whr = "proj_id = '$pid' and status = 'act'";
	if( $res = db_select_val( $dbh, 'metatext', 'maillst', $whr )) {
		$whr = "m.proj_id = p.proj_id and m.maillst = '$res' ";
		$whr .= "and m.status = 'act' and p.memb_id = $mid";
		my %p = db_select_row( $dbh, 'metatext m, projmemb p', 'p.proj_id', $whr );
		$res = $p{proj_id};
	}
	return( $res );
}

=head2 &db_maillist_pid - gets pid of top mailinglist in a hierarchy

in-param:	$dbh - database handle
in-param:	$pid - project id (may pid of sub project)
returns:	false (=0) or true (=proj_id=pid)

=cut

sub db_maillist_pid {
	my( $dbh, $pid ) = @_;
	my $res = 0;
	my $whr = "proj_id = '$pid' and status = 'act'";
	if( $res = db_select_val( $dbh, 'metatext', 'maillst', $whr )) {
		$_ = $res;
		if( /".+ (.+)" <.+>/ ) {
			$whr = "titlabb = '$1' and vers_id = 1";
			$res = db_select_val( $dbh, 'metatext', 'proj_id', $whr );
		}
	}
	return( $res );
}

=head2 &db_is_project - check projectname

in-param:	$dbh - database handle
in-param:	$pjn - project name (titlabb or proj0000)
returns:	false (=0) or true (=proj_id)

=cut

sub db_is_project {
	my( $dbh, $pjn ) = @_;
	my $pid = 0;
	if( $pjn eq 'ot' ){	# the open theory project itself
		$pid = -1;
	}
	elsif( !( $pid = db_select_val( $dbh, 'metatext', 'proj_id', 
		"titlabb = '$pjn' and vers_id = 1" ))) {
		$_ = $pjn;
		if( /proj(\d{4})/ ) {			# might by old form proj0000
			$pid = $1 + 0;		# kick leading zeros
			$pid = db_select_val( $dbh, 'metatext', 'proj_id', 
			"proj_id = $pid and vers_id = 1" );
		}
	}
	return( $pid );
}

=head2 &db_get_memb_id - reads member id with email address

in-param:	$dbh - database handle
in-param:	$addr - member email address (short form)
returns:	$mid - member id

=cut

sub db_get_memb_id {
	my( $dbh, $addr ) = @_;
	my $mid = db_select_val( $dbh, 'member', 'memb_id', "email = '$addr'" );
	return( $mid );
}

=head2 &db_set_rec_pid - set proj_id in table receive

in-param:	$dbh - database handle
in-param:	$rid - receive id
in-param:	$pid - proj_id
returns:	$res - true/false

=cut

sub db_set_rec_pid {
	my( $dbh, $rid, $pid ) = @_;
	return( db_update_col( $dbh, 'receive', 'proj_id', $pid, "rec_id = $rid" ));
}

=head2 &db_set_status - sets status code and status text in table command

in-param:	$dbh - database handle
in-param:	$cid - command id
in-param:	$stc - command result status code (number)
returns:	$res - true/false

=cut

sub db_set_status {
	my( $dbh, $cid, $stc ) = @_;
	my $stt = res( $stc );	# status text
	my $qstr = "update command set stcode = $stc, status = '$stt' where cmd_id = $cid";
	debug( "db_set_status.qstr: $qstr", 2 );
	my $qry = $dbh->prepare( $qstr );
	my $res = $qry->execute();
	return( $res );
}

=head2 &db_get_msg - reads a msg record using msg section

in-param:	$dbh - database handle
in-param:	$sec - section (number)
in-param:	$lng - language
returns:	%msg - msg hash with indexed messages

=cut

sub db_get_msg {
	my( $dbh, $sec, $lng ) = @_;
	my %msg = ();
	my $i = 0;
	if( my $txt = db_select_val( $dbh, 'msg', 'txt', "sect = $sec and lang = '$lng'" )) {
		my @p = split( /\|/, $txt );
		foreach( @p ) {
			$msg{$i++} = $_;
		}
	}
	return( %msg );
}

=head2 &db_get_mail_msg - reads a mail message using status code

in-param:	$dbh - database handle
in-param:	$stc - status code (number)
in-param:	$lng - language
returns:	$txt - message text

=cut

sub db_get_mail_msg {
	my( $dbh, $stc, $lng ) = @_;
	my $txt = 0;
	if( $txt = db_select_val( $dbh, 'msg', 'txt', "sect = 1 and lang = '$lng'" )) {
		my @msglist = split( /\|/, $txt );
		my @msg = grep( /$stc#/, @msglist );
		$_ = pop( @msg );
		/.+#(.+)/;
		$txt = $1;
	}
	return( $txt );
}

=head2 &db_get_projabb - reads short projectname from table metatext

in-param:	$dbh - database handle
in-param:	$pid - project id
returns:	$pjn - project name

=cut

sub db_get_projabb {
	my( $dbh, $pid ) = @_;
	my $pjn = db_select_val( $dbh, 'metatext', 'titlabb', "proj_id = $pid and vers_id = 1" );
	return( $pjn );
}

=head2 &db_insert_cmd - initializes and inserts a command record

S<in-param:	$dbh - database handle
in-param:	$rec_id - id of the receive record
in-param:	$cmd_id - command id
in-param:	$cmdnum - command num (of same cmd_id)
in-param:	$cmdkey - command key (the command name)
in-param:	$cmdval - command value
returns:	$status - valid=1, invalid=0>

=cut

sub db_insert_cmd {
	my( $dbh, $rec_id, $cmd_id, $cmdnum, $cmdkey, $cmdval ) = @_;
	my %rec = (
		rec_id		=> $rec_id,
		cmd_id		=> $cmd_id,
		cmdnum		=> $cmdnum,
		cmdkey		=> $cmdkey,
		cmdval		=> $cmdval
	);
	return( db_insert( $dbh, 'command', %rec ));
}

1;
