#!/usr/bin/perl
package sdevUpdateColleague;
#######################################################################
##### Author :	Shuai Weng
##### Date   :  August 2000
##### Update :  May 2001, Kane Tse
##### Description : This package contains all necessary methods for dictyBase
#####               curators to insert update colleague info  
#####               in oracle database. 
#####            
##################           RCS INFORMATION          ################
# $Author: emj466 $
# $Date: 2010/08/31 18:58:21 $
# $Header: /projects/dicty/build/source_files/db/lib/site_name/curation/sdevUpdateColleague.pm,v 1.5 2010/08/31 18:58:21 emj466 Exp $
# $Log: sdevUpdateColleague.pm,v $
# Revision 1.5  2010/08/31 18:58:21  emj466
# merged HEAD with release-2-18
# Committed on the Free edition of March Hare Software CVSNT Server.
# Upgrade to CVS Suite for more features and support:
# http://march-hare.com/cvsnt/
#
# Revision 1.4.20.1  2010/08/31 16:54:22  emj466
# merged with no-prepare-cache branch
# Committed on the Free edition of March Hare Software CVSNT Server.
# Upgrade to CVS Suite for more features and support:
# http://march-hare.com/cvsnt/
#
# Revision 1.4.24.1  2010/08/30 21:04:18  emj466
# changed prepare_cached to prepare
# Committed on the Free edition of March Hare Software CVSNT Server.
# Upgrade to CVS Suite for more features and support:
# http://march-hare.com/cvsnt/
#
# Revision 1.4  2007/06/19 15:11:13  emj466
# substitute @@_dbuser_ @@ for cgm_ddb
#
# Revision 1.3  2006/10/26 20:38:23  emj466
# change temporary file directory to not include site_name
# ie. dicty/data/submission/colleague
# instead of
# dicty/data/submission/colleague/DICTYBASE
#
# Revision 1.2  2006/10/26 15:46:51  emj466
# replaced is_dictyBase_contact with 'is_subscribed'
#
# Revision 1.1  2006/10/25 18:29:11  emj466
# new build directory
#
# Revision 1.1.1.2  2003/08/18 22:50:41  emj466
# no message
#
# Revision 1.1.1.1  2003/08/15 20:18:40  emj466
# initial load of dicty/build
#
# Revision 1.17  2003/07/25 16:55:16  shuai
# *** empty log message ***
#
# Revision 1.16  2003/05/27 23:28:45  shuai
# *** empty log message ***
#
# Revision 1.15  2003/02/18 19:18:35  shuai
# *** empty log message ***
#
# Revision 1.14  2003/01/09 23:32:37  kara
# made more changes to deal with is_subscribed
#
# Revision 1.13  2003/01/09 00:37:28  kara
# in progress: updating to deal with new is_subscribed column in
# colleague table.  still need to update populateInfo and
# populateInfoFromDB subs to read the is_subscribed data
#
# $Revision: 1.5 $
# $Source: /projects/dicty/build/source_files/db/lib/site_name/curation/sdevUpdateColleague.pm,v $
# $State: Exp $
# $Locker:  $
######################################################################  
#######################################################################
use strict;
use DBI;
use CGI qw/:all :html3 :noDebug/;
use lib "/usr/local/dicty/www_dictybase/db/lib/common";
use Login qw (ConnectToDatabase);
use TextUtil qw(DeleteUnwantedChar);
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase";
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/curation";
use FormatdictyBase qw (PrintPageTop Divider75 FooterReturnEmail);
use dictyBaseCentralMod qw(:formatPage :getInfo);
use CuratorNote qw (:updateInfo);
use sdevColleagueCurationMod qw (:formSub :insertUpdateInfo :deleteInfo);
use sdevColleague;
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/Objects/";
use Locus;
use ConfigURLdictyBase;

#######################################################################
#################### global variables #################################
#######################################################################

my $dbh;
my $dblink; 
my $dbname;
my $dir;

my $maxNumURLs = 3;

my $configUrl = ConfigURLdictyBase->new;

#######################################################################
sub new {      ############ constructor ###############################
#######################################################################

	my ($self, %args) = @_;

	$self = {};
	bless $self;

      	$self->{'_database'} = $args{'database'};
	$self->{'_user'}     = $args{'user'};
	$self->{'_id'} = param('id');

      	return $self;
}

sub database { $_[0]->{_database} }
sub user { $_[0]->{_user} }
sub title { $_[0]->{_title} }
sub help { $_[0]->{_help} }
sub id { $_[0]->{_id} }

######################################################################
sub DESTROY {   ############ destructor ##############################
######################################################################
    	if (defined $dbh) {
		$dbh->disconnect;
    	}
}

######################################################################
sub start {
######################################################################
	my ($self) = @_;

	if ($self->database eq "dictyBase") {
	    $dblink = "dictyBase";
	}
	else {
	    $dblink = "dictyBaseDEV";
	}
	$dbname = $self->database;
	$dbname = "\U$dbname";
	$self->{'_title'} = "$dbname Curator Page for Colleague Information";
	if (!$self->user) {
	    print "location: ".$configUrl->dictyBaseCGIRoot."$dblink/curatorLogin\n";
	    print "Content-type: text/html\n\n";
	    exit;
	}
	my $user = $self->user;
	$user = "\U$user";
	my ($dbuser, $dbpasswd) = &getUsernamePassword($user,
						       $self->database);
	if (!$dbuser || !$dbpasswd) {
	    print "location: ".$configUrl->dictyBaseCGIRoot."$dblink/curatorLogin\n";
	    print "Content-type: text/html\n\n";
	    exit;
	}
	$dir = "/usr/local/dicty/www_dictybase/db/data/submission/colleague";

	if (param('fname') && param('lname')) {
	    if (param('delayCB') =~ /on/i || param('deleteCB') =~ /on/i) {
		$self->processFile;
	    }
	    else {
		$dbh = &ConnectToDatabase($self->database, $dbuser, 
					  $dbpasswd);
		$self->commitInfo;
		$dbh->disconnect;
	    }
	}
	else {
	    $self->displayInfo;
	}

}

#######################################################################
sub displayInfo {
#######################################################################
    # KD: add stuff for dictyBase contact
    my ($self) = shift;

    &printStartPage($self->database, $self->title, $self->help);
      
    print b("Please check the information below and make any changes necessary."), p;
    # KD: add stuff for dictyBase contact
    my (@phone, @addr, @pi, @assocsByPi, @assocs, @keyword, @oldphone, 
	@oldaddr, @oldpi, @oldassocsByPi, @oldassocs, @oldkeyword, 
	@url, @oldURL, @loci, @oldLoci);
    $dbh = &ConnectToDatabase($self->database);

    if (!param('collId')) {
	$self->populateInfo(\@phone, \@addr, \@pi, \@assocsByPi, 
			    \@assocs, \@keyword, \@oldphone, \@oldaddr, 
			    \@oldpi, \@oldassocsByPi, \@oldassocs, 
			    \@oldkeyword, \@url, \@oldURL);
    }
    else {
	$self->populateInfoFromDB(param('collId'), \@phone, \@addr, 
			    \@pi, \@assocsByPi, \@assocs, 
			    \@keyword, \@oldphone, \@oldaddr, 
			    \@oldpi, \@oldassocsByPi, \@oldassocs, 
			    \@oldkeyword, \@url, \@oldURL);
    }
    
    print b("View current colleague ".a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/colleague/colleagueSearch?id=".$self->{'_colleague_no'}."&win=1", -target=>"infowin", -onClick=>"open_win()"}, $self->{'_lname'}.", ".$self->{'_fname'})), br;
    print b("Colleague_no = ".$self->{'_colleague_no'}), p;
       
    print startform,
          hidden(-name=>'colleague_no',
		 -value=>$self->{'_colleague_no'}),
          hidden(-name=>'id',
		 -value=>$self->id),
          hidden(-name=>'user',
		 -value=>$self->user),
          hidden(-name=>'webtitle',
		 -value=>$self->{'_webtitle'});
    print &subtitle("Your Address and Contact Information");
    print table({-border=>'0',
		 -cellpadding=>'2',
		 -cellspacing=>'3',
		 -width=>'650'},
		&updateHeader.
		##KD: adding dictyBase contact stuff ***

		&dictyBasecontact($self->{'_dictyBasecontact'}, "update", 
			  $self->{'_olddictyBasecontact'}).
	        &lastName($self->{'_lname'}, "update", 
			  $self->{'_oldlname'}).
		&firstName($self->{'_fname'}, "update", 
			  $self->{'_oldfname'}).
		&suffix($self->{'_suffix'}, "update",
			$self->{'_oldsuffix'}).
		&otherName($self->{'_oname'}, "update",
			   $self->{'_oldoname'}).
		&email($self->{'_email'}, "update",
			   $self->{'_oldemail'}).
		&jobTitle($self->{'_jobtitle'}, "update",
			   $self->{'_oldjobtitle'}).
		&profession($self->{'_profession'}, "update",
			   $self->{'_oldprofession'}).
		&institution($self->{'_institution'}, "update",
			   $self->{'_oldinstitution'}).
		&address(\@addr, "update", \@oldaddr).
	        &city($self->{'_city'}, "update", 
		      $self->{'_oldcity'}).
		&state($dbh, $self->{'_country'}, 
		       $self->{'_state'}, "update", 
		       $self->{'_oldstate'}).
		&region($self->{'_region'}, "update", 
			$self->{'_oldregion'}).
		&country($self->{'_country'}, "update", 
			$self->{'_oldcountry'}).
		&zipCode($self->{'_zip_code'}, "update", 
			$self->{'_oldzip_code'}).
		&phone(\@phone, \@oldphone, "update").
		&webPage(\@url, \@oldURL, "update")
    ), p;

    print &subtitle("Your Associates/Collaborators");
    print &associate4pi(\@assocsByPi, "update", \@oldassocsByPi,
		       $self->{'_oldPIOnly'}, $self->{'_newPIOnly'});
    print &pi(\@pi, "update", \@oldpi);
    print &associate(\@assocs, "update", \@oldassocs);

    print &subtitle("Your Research Interests");
    print &interest($self->{'_interests'}, "update", 
		    $self->{'_oldinterests'});

    print &smalltitle("Research Topics");
    print &researchTopics($self->{'_researchTopics'}, "update", 
			  $self->{'_oldResearchTopics'}, $dbh);

    print &smalltitle("Keywords");
    print &keyword(\@keyword, "update", \@oldkeyword);

    print &subtitle("Your Comments");
    print &comment($self->{'_Comments'}, "update",
		   $self->{'_oldComments'});

    print &subtitle("Curator Section");

    print &smalltitle("Associated Genes");
    print &associatedLoci($self->{'_newLoci'}, "update",
			  $self->{'_oldLoci'}, $dbh);

    print &smalltitle("Curator Note:");
    print &newCuratorNote;
    print &delayDelete;

    print p, font({-color=>'red'}, "Note: please check the 'Associates/Collaborators' section to make sure the format for each name is correct."),p;

    print &submitReset;
    print end_form;
    $dbh->disconnect;
    &printEndPage;
}


#######################################################################
sub commitInfo {
#######################################################################
    my ($self) = shift;

    &printStartPage($self->database, $self->title, $self->help);
    $self->processData;

    print b("Colleague_no = ".param('colleague_no')),p;

    print b("Please wait"), ", committing data into the database...", p;


    my $collObject = sdevColleague->new(dbh=>$dbh,
					colleagueNo=>param('colleague_no'));

    $self->updateColleague($collObject);
    $self->updatePhone($collObject);
    $self->updatePi($collObject);
    $self->updateEmail($collObject);
    $self->updateUrl($collObject);
    $self->updateAssociate4pi($collObject);
    $self->updateAssociate($collObject);
    $self->updateResearchTopics($collObject);
    $self->updateKeyword($collObject);
    $self->updateAssociatedLoci($collObject);
    $self->updateComment($collObject);
    $self->updateInterest($collObject);
    $self->insertNote;

    print p, b("All updates completed.");
    print br, "The colleague entry has been successfully commited into database!", p;
    print b("View current colleague ".a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/colleague/colleagueSearch?id=".param('colleague_no')."&win=1", -target=>"infowin", -onClick=>"open_win()"}, param('lname').", ".param('fname'))),p;

    my $id = param('id');
    if ($id) {
	system("/bin/mv $dir/$id.MajorUpdate $dir/archive/");
    }
    &returnForm($self->user, $dblink);
    &printEndPage;
}

#######################################################################
sub updateColleague {
#######################################################################
    my ($self, $collObject) = @_;

    my $setStmt = $self->getSetStatement($collObject);
  
    #print ("$setStmt"),p;
    my $sth = $dbh->prepare("
         UPDATE CGM_DDB.colleague set $setStmt
         WHERE colleague_no = ?
    ");

    my $tmpVar = param('colleague_no');

    eval { $sth->execute(param('colleague_no')); };

    if ($@) {

	print "Error occurred when inserting colleague info into colleague table.",p, $@,p;

	print $setStmt,p;


    }
    else {

	print "The ".font({-color=>'red'}, b("colleague"))." table has been updated.", br;

    }

}

#######################################################################
sub updateComment {
#######################################################################
    my ($self, $collObject) = @_;
    my $update;

    if ($collObject->comment eq param('Comments')) { return;}
    if ($collObject->comment && param('Comments')) {
	my $sth = $dbh->prepare("
             UPDATE CGM_DDB.colleague_remark 
             SET    remark = ?
             WHERE  colleague_no = ?
             AND    remark_type = 'Announcement' 
        ");
	$sth->execute(param('Comments'), param('colleague_no'));
	$update++;
    }
    elsif ($collObject->comment) {
	my $sth = $dbh->prepare("
             DELETE from CGM_DDB.colleague_remark  
             WHERE  colleague_no = ?
             AND    remark_type = 'Announcement' 
        ");
	$sth->execute(param('colleague_no'));
	$update++;
    }
    elsif (param('Comments')){
	&insertComments($dbh, param('colleague_no'), 
			$self->user, param('Comments'),
			"Announcement");
	$update++;
    }
    if ($update) {
	print "The user comment in ".font({-color=>'red'}, b("colleague_remark"))." table has been updated.", br;
    }
}

#######################################################################
sub updateInterest {
#######################################################################
    my ($self, $collObject) = @_;
    my $update;
    if ($collObject->interest eq param('interests')) { return;}
    if ($collObject->interest && param('interests')) {
	my $sth = $dbh->prepare("
             UPDATE CGM_DDB.colleague_remark 
             SET    remark = ?
             WHERE  colleague_no = ?
             AND    remark_type = 'Research Interest' 
        ");
	$sth->execute(param('interests'), param('colleague_no'));
	$update++;
    }
    elsif ($collObject->interest) {
	my $sth = $dbh->prepare("
             DELETE from CGM_DDB.colleague_remark  
             WHERE  colleague_no = ?
             AND    remark_type = 'Research Interest' 
        ");
	$sth->execute(param('colleague_no'));
	$update++;
    }
    elsif (param('interests')){
	&insertComments($dbh, param('colleague_no'), 
			$self->user, param('interests'),
			"Research Interest");
	$update++;
    }
    if ($update) {
	print "The research interest in ".font({-color=>'red'}, b("colleague_remark"))." table has been updated.", br;
    }

}

#######################################################################
sub updateAssociate4pi {
#######################################################################
    my ($self, $collObject) = @_;
    my %newAssoc;
    for (my $i = 1; $i <= 10; $i++) {
	my $assoc = param("associate$i");
	&DeleteUnwantedChar(\$assoc);
	if (!$assoc) { next;}
	$newAssoc{$assoc}++;
    }
    my %oldAssoc;
    my $assocRef = $collObject->associate4piRef; 
    my $update;
    foreach my $rowRef (@$assocRef) { 
	my($colleagueNo, $lname, $fname, $suffix) = @$rowRef;
	my $assoc = $lname.", ".$fname;
	$oldAssoc{$assoc}++;
	if ($newAssoc{$assoc}) { next; }
	&deleteAssocsBYpi($dbh, param('colleague_no'), $colleagueNo);
	$update++;
    }
    my @newAssoc;
    for (my $i = 1; $i <= 10; $i++) {
	my $assoc = param("associate$i");
	&DeleteUnwantedChar(\$assoc);
	if (!$assoc) { next;}
	if ($oldAssoc{$assoc}) { next; }
	push(@newAssoc, $assoc);
    }
    if (@newAssoc) {
	&insertAssocsBYpi($dbh, param('colleague_no'), 
			  $self->user, @newAssoc);
	$update++;
    }
    # check if this record should be associated with ~Generic ~Associate or no
    my $setGenAssoc = "false";
    if (defined param('newPIOnly')) {
	$setGenAssoc = "true";
    }
    $update+= &updateGenericAssociate($dbh, param('colleague_no'), 
			    $self->user, $setGenAssoc,
			    @newAssoc);
    if ($update) {
	print "Associates by pi info in ".font({-color=>'red'}, b("pi"))." and ".font({-color=>'red'}, b("colleague"))." table has been updated.", br;
    }

}

#######################################################################
sub updateAssociate {
#######################################################################
    my ($self, $collObject) = @_;
    my %newAssoc;
    for (my $i = 11; $i <= 20; $i++) {
	my $assoc = param("associate$i");
	&DeleteUnwantedChar(\$assoc);
	if (!$assoc) { next;}
	$newAssoc{$assoc}++;
    }
    my %oldAssoc;
    my $assocRef = $collObject->associateRef; 
    my $update;
    foreach my $rowRef (@$assocRef) { 
	my($colleagueNo, $lname, $fname, $suffix) = @$rowRef;
	my $assoc = $lname.", ".$fname;
	$oldAssoc{$assoc}++;
	if ($newAssoc{$assoc}) { next; }
	&deleteAssocs($dbh, param('colleague_no'), $colleagueNo);
	$update++;
    }
    my @newAssoc;
    for (my $i = 11; $i <= 20; $i++) {
	my $assoc = param("associate$i");
	&DeleteUnwantedChar(\$assoc);
	if (!$assoc) { next;}
	if ($oldAssoc{$assoc}) { next; }
	push(@newAssoc, $assoc);
    }
    if (@newAssoc) {
	&insertAssocs($dbh, param('colleague_no'), 
			  $self->user, @newAssoc);
	$update++;
    }
    if ($update) {
	print "Associates info in ".font({-color=>'red'}, b("pi"))." and ".font({-color=>'red'}, b("colleague"))." table has been updated.", br;
    }
}

#######################################################################
sub updateUrl {
#######################################################################

    my ($self, $collObject) = @_;

    my %updatedURLs;

    my $colleagueID = param('colleague_no');

    my $updateURLtable = 0;
    my $updateCOLL_URLtable = 0;

    # retrieve a list of all URLs belonging to this colleagueID from the
    #   the database
    my $sthGetAllURLNo = $dbh->prepare("
       SELECT CU.url_no
       FROM   CGM_DDB.coll_url CU
       WHERE  CU.colleague_no = ?
    ");
    $sthGetAllURLNo->execute($colleagueID);

    my $sthGetURLNo = $dbh->prepare ("
           SELECT U.url_no
           FROM   CGM_DDB.url U
           WHERE  U.url = ?
        ");

    my $sthGetURLNoWithColleagueID = $dbh->prepare ("
           SELECT U.url_no
           FROM   CGM_DDB.coll_url CU, CGM_DDB.url U
           WHERE  U.url = ?
           AND    U.url_no = CU.url_no
           AND    CU.colleague_no = ?
        ");

    my $sthCountColleaguesUsingURL = $dbh->prepare ("
           SELECT count(CU.colleague_no)
           FROM   CGM_DDB.coll_url CU
           WHERE  CU.url_no = ?
        ");

    while (my $array_ref = $sthGetAllURLNo->fetchrow_arrayref) {
	$updatedURLs{$array_ref->[0]} = 0;
    }

    # iterate through each of the newly-entered URLs
    for (my $urlNo = 0; $urlNo < $maxNumURLs; $urlNo++) {
        my $url = param("url$urlNo");
	my $urlTitle = param("WebTitle$urlNo");
	my $urlType = param("url_type$urlNo");

# 	print "Submitted URL: $url -- $urlTitle -- $urlType". br;

	if ($urlType =~ /Please specify/) {
	    next;
	}

	# retrieve the title of the webpage from the web
	if (length($urlTitle) == 0) {
            my $ua = new LWP::UserAgent;
            my $reqUrl = new HTTP::Request GET => $url;
            $reqUrl->content_type('application/x-www-form-urlencoded');
            my $resUrl = $ua->request($reqUrl);
            if ($resUrl->is_success) {
                my $output = $resUrl->content;
                if ($output =~ /<title>(.+)<\/title>/i) {
                    $urlTitle = $1;
                }
                else { $urlTitle = ""; }
            }
            else { $urlTitle = ""; }
        }

	# trim unnecessary blanks/spaces
	$url =~ s/[,;]/ /g;
	$url =~ s/ +/ /g;
	&DeleteUnwantedChar(\$url);

	my $oldUrl = param("oldUrl$urlNo") || "";
	my $oldUrlTitle = param("oldWebTitle$urlNo") ||  "";
	my $oldUrlType = param("oldurl_type$urlNo") || "";

#	print "... Is this URL ($url) already in the database?\n". br;

	$sthGetURLNo->execute($url);

	if (my $array_ref = $sthGetURLNo->fetchrow_arrayref) {
	    # ... if we are able to retreive a URL_No, this implies that the
	    #  record already exists in the database, and therefore, it
	    #  must be updated

	    my $existingRecordURLNo = $array_ref->[0];
#	    print "... ... Yes! Found a URL_NO for this URL. ", 
#		 "It is $existingRecordURLNo<BR>\n";

	    # ... determine if this colleague is currently associated with
	    #     this URL or not
#	    print "... Checking to see if this colleague [$colleagueID] is ".
#		 "currently associated with this URL [$existingRecordURLNo]".
#		 br. "\n";
	    $sthGetURLNoWithColleagueID->execute($url, 
						 $colleagueID);
	    if (my $array_ref3 
		= $sthGetURLNoWithColleagueID->fetchrow_arrayref) {
		$existingRecordURLNo = $array_ref3->[0];
#		print ("... ... This colleague is already associated with ".
#		       "this URL.".
#		       br);
	    }
	    else {
#		print ("... ... This colleague is not yet associated with ".
#		       "this URL.\n". br);
		my $sth2 = $dbh->prepare ("
                       INSERT INTO CGM_DDB.coll_url CU 
                                   (CU.colleague_no, CU.url_no)
                       VALUES      (?, ?)
                       ");
		$sth2->execute($colleagueID, $existingRecordURLNo);

		$updateCOLL_URLtable++;

	    }

	    # only attempt to update the database if there are actually
	    #  validate changes to make
	    if ((($oldUrl ne $url)
		 || ($oldUrlType ne $urlType) 
		 || ($oldUrlTitle ne $urlTitle))
		&& (($urlType !~ /Please specify/)
		    &&(length($url) > 0))
	       ) {
#		print ("... The submitted URL is different from the existing".
#		       " URL.  The information associated with this URL will ".
#		       "now be updated.\n". br);

		# now we must see if anyone else is also using this URL
		#  If not, then we can go ahead and modify it; otherwise
		#  we must make a copy (and modify the copy only), so that
		#  anyone else who is currently using this URL will not be
		#  affected by any changes.

		$sthCountColleaguesUsingURL->execute($existingRecordURLNo);
		my $array_ref2 
		     = $sthCountColleaguesUsingURL->fetchrow_arrayref;

		if ($oldUrl eq $url) {
		    # update the associated URL table information
		    my $sth = $dbh->prepare ("
                              UPDATE CGM_DDB.url U
                              SET    U.url = ?,
                                     U.url_type = ?,
                                     U.www_name = ?
                              WHERE  U.url_no = ?
                    ");
		    $sth->execute($url,
				  $urlType,
				  $urlTitle,
				  $existingRecordURLNo);
		    $updateURLtable++;
		}
		elsif ($array_ref2->[0] > 1) {
		    print ("Note: ". 
			   $array_ref2->[0]
			   ." colleagues are using the URL ($url).\n". br);
		}
		else {
#		    print "... Updating the URL<BR>\n";
		    my $sth = $dbh->prepare ("
                              UPDATE CGM_DDB.url U
                              SET    U.url = ?,
                                     U.url_type = ?,
                                     U.www_name = ?
                              WHERE  U.url_no = ?
                    ");
		    $sth->execute($url,
				  $urlType,
				  $urlTitle,
				  $existingRecordURLNo);
		    $updateURLtable++;
		}
		$updatedURLs{$existingRecordURLNo} = 1;
	    }
	    else {
#		print "... The submitted URL is not different from the existing URL.  No changes to the database are needed.<BR>\n";
		# mark this URL number as 'updated' so that it won't be deleted
		$updatedURLs{$existingRecordURLNo} = 1;
	    }
	}
	else {
	    # ... if we are unable to retrieve a URL_NO, this implies that the
	    # record is a new record, and thus must be inserted into the
	    # CGM_DDB.URL table and link to this colleagueID through the
	    # CGM_DDB.COLL_URL table

	    if ($urlType !~ /Please specify/) {
#		print "... No. Unable to retrieve a URL_NO for this URL.  It must be a new URL<br>";

		$sthGetURLNo->execute($url);
		my $urlNo;
		if (my $array_ref2 = $sthGetURLNo->fetchrow_arrayref) {
		    $urlNo = $array_ref2->[0]
		}
		else {
		    my $sth = $dbh->prepare ("
                                INSERT INTO CGM_DDB.url U
                                            (U.url, U.url_type, U.www_name)
                                VALUES      (?, ?, ?)
                   ");
		    $sth->execute($url, $urlType, $urlTitle);
		    $sthGetURLNo->execute($url);
		    $array_ref2 = $sthGetURLNo->fetchrow_arrayref;
		    $urlNo = $array_ref2->[0];
		    $updateURLtable++;

		}
		my $sth2 = $dbh->prepare ("
                       INSERT INTO CGM_DDB.coll_url CU 
                                   (CU.colleague_no, CU.url_no)
                       VALUES      (?, ?)
                       ");
		$sth2->execute($colleagueID, $urlNo);
		$updateCOLL_URLtable++;
	    }
	}
    }

    # look for URLs that existed before; but now are blank.  That implies that
    #  such URLs should be deleted.
    foreach my $existingURLKeyNo (keys %updatedURLs) {
	if ($updatedURLs{$existingURLKeyNo} == 0) {
	    # only delete the URL itself if this is the *only* colleague
	    #   using this URL
	    $sthCountColleaguesUsingURL->execute($existingURLKeyNo);
	    my $array_ref2 
		 = $sthCountColleaguesUsingURL->fetchrow_arrayref;

	    if ($array_ref2->[0] == 1) {
		my $sthDeleteFromURLTable = $dbh->prepare ("
                   DELETE FROM CGM_DDB.url U
                   WHERE       U.url_no = ? ");

		$sthDeleteFromURLTable->execute($existingURLKeyNo);

		$updateURLtable++;
	    }
	    else {
		print ("Note: Number of other colleagues using this URL = ". 
		       $array_ref2->[0]
		       .".". br . 
		       "This URL will not be deleted from the URL table, ".
		       "only this colleague will no longer be associated ".
		       "with this URL."
		       . br);
	    }

	    my $sthDeleteFromCOLL_URLTable = $dbh->prepare ("
              DELETE FROM CGM_DDB.coll_url CU
              WHERE       CU.url_no = ?
              AND         colleague_no = ?");

	    $sthDeleteFromCOLL_URLTable->execute($existingURLKeyNo,
						 $colleagueID);

	    $updateCOLL_URLtable++;
	}
    }

    if ($updateURLtable) {
	print "URL info in the "
	     .font({-color=>'red'},b("url"))." table has been updated.", br;
    }
    if ($updateCOLL_URLtable) {
	print "URL info in the "
	     .font({-color=>'red'}, b("coll_url"))." table has been updated.", br;
    }

#     print "Leaving updateUrl() of sdevUpdateColleague.pm<BR>\n";
}

#######################################################################
sub updatePhone {
#######################################################################
    my ($self, $collObject) = @_;
    my %newPhone;
    for( my $i = 1; $i <= 5; $i++) {
	my $phone = param("phone$i");
	&DeleteUnwantedChar(\$phone);
	if (!$phone) { next;}
	my $phoneKey = param("phone_type$i").":".$phone;
	$newPhone{$phoneKey}++;
    }
    my %oldPhone;
    my $update;
    my $phoneRef = $collObject->phoneRef;
    foreach my $rowRef (@$phoneRef) { 
	my ($phoneNum, $phoneType, $phoneLoc) = @$rowRef;
	my $phoneKey;
	if ($phoneLoc =~ /unspecified/i) {
	    $phoneKey = $phoneType.":".$phoneNum;
	}
	else {
	    $phoneKey = $phoneLoc." ".$phoneType.":".$phoneNum;
	}
	$oldPhone{$phoneKey}++;
	if ($newPhone{$phoneKey}) { next;}
	$update++;
	my $phone_no = $self->getPhoneNum($phoneNum, $phoneType,
					  $phoneLoc);
	if ($phone_no) {
	    my $sth = $dbh->prepare("
                 DELETE from CGM_DDB.coll_phone
                 WHERE  colleague_no = ?
                 AND    phone_no = ?
            ");
	    $sth->execute(param('colleague_no'), $phone_no);
	    $dbh->commit;
	    $sth = $dbh->prepare( "
                 SELECT  colleague_no
                 FROM    CGM_DDB.coll_phone
                 WHERE   phone_no = ?
            ");
	    $sth->execute($phone_no);
	    my $other_colleague_no;
	    
	    while(my($number) = $sth->fetchrow()) {
		$other_colleague_no = $number;
	    }
	    if (!$other_colleague_no) {
		$sth = $dbh->prepare("
                    DELETE from CGM_DDB.phone
                    WHERE  phone_no = ?
                ");
		$sth->execute($phone_no);
	        $dbh->commit;
	    }
	}
    }
    for( my $i = 1; $i <= 5; $i++) {
	my $phone_num = param("phone$i");
	&DeleteUnwantedChar(\$phone_num);
	if (!$phone_num) { next;}
	my $phoneKey = param("phone_type$i").":".$phone_num;
	if ($oldPhone{$phoneKey}) { next;}
	$update++;
	my ($phone_location, $phone_type) 
	    = split(' ', param("phone_type$i"));
	if (!$phone_type) {
	    $phone_type = $phone_location;
	    $phone_location = "Unspecified";
        }
	my $phone_no = $self->getPhoneNum($phone_num, $phone_type,
					  $phone_location);
	if (!$phone_no) {
	    my $sth = $dbh->prepare("
                INSERT INTO CGM_DDB.phone(phone_no, phone_num, phone_type,
                                       phone_location, created_by)
                VALUES(CGM_DDB.phoneno_seq.nextval, ?,?,?,?)
            ");
	    $sth->execute($phone_num, $phone_type, $phone_location,
			  $self->user);
	    $dbh->commit;
	    $sth = $dbh->prepare("
                INSERT INTO CGM_DDB.coll_phone (colleague_no, phone_no) 
                VALUES (?, CGM_DDB.phoneno_seq.currval)
            ");
	    $sth->execute(param('colleague_no'));
	}
	else {
	    my $sth = $dbh->prepare("
                INSERT INTO CGM_DDB.coll_phone (colleague_no, phone_no) 
                VALUES (?,?)
            ");
	    $sth->execute(param('colleague_no'), $phone_no);
	}
	$dbh->commit;		   
    }
    if ($update) {
	print "Phone info in ".font({-color=>'red'}, b("phone"))." and ".font({-color=>'red'}, b("coll_phone"))." tables have been updated.", br;
    }
}

#######################################################################
sub updatePi {
#######################################################################
    my ($self, $collObject) = @_;
    my %newPi;
    for (my $i = 0; $i <= 1; $i++) {
	my $pi = param("PILIST$i");
	&DeleteUnwantedChar(\$pi);
	if (!$pi) { next;}
	$newPi{$pi}++;
    }
    my %oldPi;
    my $piRef = $collObject->piRef; 
    my $update;
    foreach my $rowRef (@$piRef) { 
	my($colleagueNo, $lname, $fname, $suffix) = @$rowRef;
	my $pi = $lname.", ".$fname;
	$oldPi{$pi}++;
	if ($newPi{$pi}) { next; }
	&deletePi($dbh, param('colleague_no'), $lname, $fname, $suffix);
	$update++;
    }
    for (my $i = 0; $i <= 1; $i++) {
	my $pi = param("PILIST$i");
	&DeleteUnwantedChar(\$pi);
	if (!$pi) { next;}
	if ($oldPi{$pi}) { next; }
	&insertPi($dbh, param('colleague_no'), $self->user, $pi);
	$update++;
    }
    if ($update) {
	print "The ".font({-color=>'red'}, b("pi"))." table has been updated.", br;
    }
}

#######################################################################
sub updateAssociatedLoci {
#######################################################################
    my ($self, $collObject) = @_;

    my @oldAssociatedLoci = split(/\|/, param('oldAssociatedLoci'));
    my $userLociList = param('associatedLoci');
    $userLociList =~ s/\s+/\|/g;
    my @associatedLoci = ();

    # translate associatedLoci from LOCUS_NAMEs or LOCUS_NOs into LOCUS_NOs
    #   only
    foreach my $locus (split(/\|/, $userLociList)) {
	if (length($locus) <= 1) { next; }
	my $locusObj;
	undef $locusObj;
	if ($locus =~ /^(\d+)$/) {
	    # otherwise, assume $locus contains a locus number
	    $locusObj = Locus->new(dbh=>$dbh,
				   locus_no=>$locus
				  );
	}
	else {
	    # $locus contains a locus name and needs to be looked up
	    # print "Trying locus named: \"$locus\"", br;
	    $locusObj = Locus->new(dbh=>$dbh,
				   locus_name=>uc($locus)
				  );
	}

	if (defined $locusObj) {
	    push(@associatedLoci, $locusObj->locus_no());
	}
	else {
	    print "Unable to locate the locus specified by \"", $locus,
		 "\" in the list of associated loci.\n", br;
	}
    }

    if (($#associatedLoci < 0 ) 
	&& ($#oldAssociatedLoci < 0)) { return; }

    my @deleteLociList = ();
    my @insertLociList = ();
    { # find out which loci are in one list but not the other
	my %oldLoci;
	my %newLoci;

	# add all old loci to a list
	foreach my $oldLocusNo (@oldAssociatedLoci) {
	    $oldLoci{$oldLocusNo} = 1;
	}

	# add all new loci to a list,
	#   also, if these loci do not appear in %oldLoci, then mark them for
	#   addition
	foreach my $newLocusNo (@associatedLoci) {
	    $newLoci{$newLocusNo} = 1;

	    if (!defined $oldLoci{$newLocusNo}) {
		push(@insertLociList, $newLocusNo);
	    }
	}

	# compare the list of new loci to old loci; any loci that are in the
	#   %oldLoci, but NOT present in %newLoci should be deleted
	foreach my $oldLocusNo (@oldAssociatedLoci) {
	    if (!defined $newLoci{$oldLocusNo}) {
		push(@deleteLociList, $oldLocusNo);
	    }
	}
    }

    if ((scalar @insertLociList == 0) && (scalar @deleteLociList == 0)) {
	# do not proceed with any updates if there are no associated loci to
	#   insert or delete to/from the coll_locus table
	return;
    }

    my $errLocusNo;
    my $opType;
    eval {
	$opType = "INSERT";
	foreach my $locusNo (@insertLociList) {
	    $errLocusNo = $locusNo;
	    my $sth = $dbh->prepare("
                INSERT INTO CGM_DDB.coll_locus(LOCUS_NO, COLLEAGUE_NO)
                VALUES (?, ?)
            ");
	    $sth->execute($locusNo, $collObject->colleagueNo);
	}

	$opType = "DELETE";
	foreach my $locusNo (@deleteLociList) {
	    $errLocusNo = $locusNo;
	    my $sth = $dbh->prepare("
                DELETE FROM CGM_DDB.coll_locus
                WHERE locus_no = ? AND
                      colleague_no = ?
          ");
	    $sth->execute($locusNo, $collObject->colleagueNo);
	}
    };
    if ($@) {
	print "An error was encountered while attempting to ".$opType." associated locus ($errLocusNo) information into the ".font({-color=>'red'}, b("coll_loci"))." table.", p;
	my $errorMessage = $@;
	print code($errorMessage), br;
	print code(DBI::errstr), p;

	print "For precautionary purposes, all updates to the ".font({-color=>'red'}, b("coll_loci"))." table have been rolled back.", p;

	print "This is the list of associated loci ", code($userLociList),
	     ".  You may wish to copy this information for future use.";

	$dbh->rollback();
    }
    else {
	print "Associated loci information has been updated into ".font({-color=>'red'}, b("coll_locus"))." table.", br;
	    $dbh->commit();
    }

    return;

}

#######################################################################
sub updateEmail {
#######################################################################
    my ($self, $collObject) = @_;
    my $emails = param('email');
    $emails =~ s/[,;]/ /g;
    $emails =~ s/ +/ /g;
    &DeleteUnwantedChar(\$emails);
    my @email = split(/ /, $emails);
    my %newEmail;
    foreach my $email (@email) {
	$newEmail{$email}++;
    }
    my $update;
    my %oldEmail;
    my $emailRef = $collObject->emailRef;
    foreach my $rowRef (@$emailRef) {
	my ($email) = @$rowRef;
	$oldEmail{$email}++;
	if ($newEmail{$email}) { next;}
	my $sth = $dbh->prepare( "
            SELECT E.email_no, CE.colleague_no
            FROM   CGM_DDB.coll_email CE, CGM_DDB.email E
            WHERE  E.email = ?
            AND    E.email_no = CE.email_no
        ");
	$sth->execute($email);
	my ($email_no, $other_colleague_no);
	while(my($TMPemail_no, $TMPcolleague_no)=$sth->fetchrow()){
	    if ($TMPcolleague_no == param('colleague_no')) {
	        $email_no = $TMPemail_no;
	    }
	    else {
	        $other_colleague_no = $TMPcolleague_no;
	    }
	}
	if ($email_no) {
	    $update++;
	    $sth = $dbh->prepare("
                DELETE from CGM_DDB.coll_email
                WHERE  colleague_no = ?
                AND    email_no = ?
            "); 
	    $sth->execute(param('colleague_no'), $email_no);
	    if (!$other_colleague_no) {
		$sth = $dbh->prepare("
                    DELETE from CGM_DDB.email
                    WHERE  email_no = ?
                ");
		$sth->execute($email_no);
	    }
        } 
    }
    my @newEmail;
    foreach my $email (@email) {
	if ($oldEmail{$email}) { next; }
	push(@newEmail, $email);
    }
    if (@newEmail) {
	$update++;
	&insertEmails($dbh, param('colleague_no'), $self->user, @newEmail);
    }
    if ($update) {
	print "Email info in ".font({-color=>'red'},b("email"))." and ".font({-color=>'red'}, b("coll_email"))." tables have been updated.", br;
    }

}

#######################################################################
sub updateKeyword {
#######################################################################
    my ($self, $collObject) = @_;
    my %newKw;
    for (my $i = 1; $i <= 10; $i++) {
	my $kw = param("keyword$i");
	if (!$kw) { next;}
	$newKw{$kw}++;
    }
    my %oldKw;
    my $update;
    my $keywordRef = $collObject->keywordRef;
    my @oldKw;
    foreach my $rowRef (@$keywordRef) {
	my ($kw) = @$rowRef;
	$oldKw{$kw}++;
	if ($newKw{$kw}) { next;}
	push(@oldKw, $kw);
    }
    if (@oldKw) {
	&deleteKeywords($dbh, param('colleague_no'), @oldKw);
	$update++;
    }
    my @newKw;
    for (my $i = 1; $i <= 10; $i++) {
	my $kw = param("keyword$i");
	if (!$kw) { next;}
	if ($oldKw{$kw}) { next; }
	push(@newKw, $kw);
    }
    if (@newKw) {
	&insertKeywords($dbh, param('colleague_no'), $self->user, @newKw);
	$update++;
    }
    if ($update) {
	print "keyword info in ".font({-color=>'red'}, b("coll_keyword"))." and ".font({-color=>'red'}, b("keyword"))." tables have been updated.", br;
    }
       
}

#######################################################################
sub updateResearchTopics {
#######################################################################
    my ($self, $collObject) = @_;

    $self->{'_researchTopics'} = "\t" . $self->{'_researchTopics'} . "\t";
    $self->{'_researchTopics'} =~ s/\t+/\t/;

    my $researchTopicList = &getCDKeywords($dbh);

    my $newRT = param('researchTopics');

    foreach my $rt (split(/\t/, $researchTopicList)) {
	my $value = param($rt);
	if ($value eq "on") {
	    $newRT .= "\t" . "$rt";
	}
    }
    $newRT .= "\t";
    my $oldRT = "";

    my $rtArrayRef = $collObject->researchTopicsRef;
    foreach my $rowRef (@$rtArrayRef) {
	my ($rt) = @$rowRef;
	$oldRT .= "\t" . $rt;
    }
    $oldRT = "\t" . $oldRT . "\t";
    $oldRT =~ s/\t+/\t/;

    my $addRTList = "";
    my $delRTList = "";
    foreach my $rt (split(/\t/, $researchTopicList)) {
	if (($newRT !~ /\t$rt\t/) && ($oldRT =~ /\t$rt\t/)) {
	    $delRTList .= "\t" . $rt;
	}
	elsif (($newRT =~ /\t$rt\t/) && ($oldRT !~ /\t$rt\t/)) {
	    $addRTList .= "\t" . $rt;
	}
    }

    my $update = 0;
    foreach my $deletedRT (split(/\t/, $delRTList)) {
	if (length($deletedRT) < 1) { next; }
	my $keywordNo;
	eval {
	    my $sthGetRTNo = $dbh->prepare("
               SELECT keyword_no
               FROM   CGM_DDB.keyword
               WHERE  source = 'Curator-defined'
               AND    keyword = ?
               ");
	    $sthGetRTNo->execute($deletedRT);
	    $keywordNo = ($sthGetRTNo->fetchrow_array)[0];
	    my $sthDeleteCollRT = $dbh->prepare("
               DELETE from CGM_DDB.coll_keyword
               WHERE  colleague_no = ?
               AND    keyword_no = ?
            ");
	$sthDeleteCollRT->execute(param('colleague_no'),
				  $keywordNo);
	};
	if ($@) {
	    print "An error has occurred while attempting to remove an",
		  "old research/colleague association ($deletedRT [$keywordNo], ",
		  "param('colleague_no'))\n";
	}
	else {
	    $update++;
	}
    }
    foreach my $addedRT (split(/\t/, $addRTList)) {
	if (length($addedRT) < 1) { next; }
	my $keywordNo;
	eval {
	    my $sthGetRTNo = $dbh->prepare("
               SELECT keyword_no
               FROM   CGM_DDB.keyword
               WHERE  source = 'Curator-defined'
               AND    keyword = ?
            ");
	    $sthGetRTNo->execute($addedRT);
	    $keywordNo = ($sthGetRTNo->fetchrow_array)[0];

	    $sthGetRTNo->finish;

	    my $sthAddCollRT = $dbh->prepare("
               INSERT INTO CGM_DDB.coll_keyword(colleague_no, keyword_no)
               VALUES (?, ?)
            ");
	    $sthAddCollRT->execute(param('colleague_no'),
				   $keywordNo);

	    $sthAddCollRT->finish;

	};
	if ($@) {
	    print "An error has occurred while attempting to insert a",
		  "new research topic/colleague association ($addedRT [$keywordNo], ",
		  "param('colleague_no'))\n";
	}
	else {
	    $update++;
	}
    }

    if ($update) {
	print "Research Topics ($update) in ".font({-color=>'red'}, b("coll_keyword"))." and ".font({-color=>'red'}, b("keyword"))." tables have been updated.", br;
    }
}

#######################################################################
sub insertNote {
#######################################################################
    my ($self) = @_;
    if (!param('note')) { return;}
    my $idList = param('idList');
    &DeleteUnwantedChar(\$idList);
    $idList =~ s/\, */\,/g;
    $idList =~ s/ +/ /g;
    my $collEntry = "Colleague,".param('colleague_no');
    if (!$idList) {
	$idList = $collEntry;
    }
    elsif ($idList !~ /$collEntry/i) {
	$idList .= " ".$collEntry;
    }
    &insertNote4idList($dbh, $self->user, param('note'), 
		       param('isPublic'), $idList);
    print "The note has been inserted into curator_note table.", br;
}

#######################################################################
sub getPhoneNum {
#######################################################################
    my ($self, $phoneNum, $phoneType, $phoneLoc) = @_;
    my $sth = $dbh->prepare("
        SELECT phone_no
        FROM   CGM_DDB.phone
        WHERE  phone_num = ?
        AND    phone_type = ?
        AND    phone_location = ?
    ");
    $sth->execute($phoneNum, $phoneType, $phoneLoc);
    my $phone_no = $sth->fetchrow;
    $sth->finish;
    return $phone_no;
}

#######################################################################
sub processFile {
#######################################################################
    my ($self) = shift;

    &printStartPage($self->database, $self->title, $self->help);

    if (!$self->id) { $self->{'_id'} = param('id'); }

    if (param('delayCB') =~ /on/i) { 
	&delayFile($self->id, $dir, param('delayComment'), $self->user);
    }
    else {
	&deleteFile($dir, $self->id.".MajorUpdate");
    }
    &returnForm($self->user, $dblink);
    &printEndPage;
}

#######################################################################
sub populateInfoFromDB {
#######################################################################
    my ($self, $colleagueNo, $phoneRef, $addrRef, $piRef, 
	$assocsByPiRef, $assocsRef, $keywordRef,
	$oldphoneRef, $oldaddrRef, $oldpiRef, 
	$oldassocsByPiRef, $oldassocsRef, $oldkeywordRef, 
	$urlRef, $oldUrlRef, $lociRef, $oldLociRef) = @_;

    my $collObject = sdevColleague->new('database'=>$self->database,
					colleagueNo=>$colleagueNo);
    $self->{'_colleague_no'} = $colleagueNo;
    $self->{'_lname'} = $collObject->lname;
    $self->{'_oldlname'} = $collObject->lname;

    $self->{'_fname'} = $collObject->fname;
    $self->{'_oldfname'} = $collObject->fname;

    $self->{'_suffix'} = $collObject->suffix;
    $self->{'_oldsuffix'} = $collObject->suffix;
    ## KD: adding stuff for dictyBase contact
    $self->{'_dictyBasecontact'} = $collObject->dictyBasecontact;
    $self->{'_olddictyBasecontact'} = $collObject->dictyBasecontact;

#    print "contact in DB = ", $self->{'_dictyBasecontact'}, p;
    
    {
	my $arrayRef = $collObject->emailRef;
	foreach my $rowRef (@$arrayRef) { 
	    my ($email) = @$rowRef;
	    $self->{'_email'} .= " ".$email;
	}
    }

    $self->{'_email'} =~ s/^ //;
    $self->{'_oldemail'} = $self->{'_email'};

    $self->{'_oname'} = $collObject->oname;
    $self->{'_oldoname'} = $collObject->oname;
    
    $self->{'_profession'} = $collObject->profession;
    $self->{'_oldprofession'} = $collObject->profession;

    $self->{'_jobtitle'} = $collObject->jobTitle;
    $self->{'_oldjobtitle'} = $collObject->jobTitle;

    $self->{'_institution'} = $collObject->institution;
    $self->{'_oldinstitution'} = $collObject->institution;

    @$addrRef = ($collObject->address1, $collObject->address2, 
		 $collObject->address3, $collObject->address4,
		 $collObject->address5);
    @$oldaddrRef = @$addrRef;
    
    $self->{'_city'} = $collObject->city;
    $self->{'_oldcity'} = $collObject->city;

    $self->{'_state'} = $collObject->state;
    $self->{'_oldstate'} = $collObject->state;

    $self->{'_region'} = $collObject->region;
    $self->{'_oldregion'} = $collObject->region;
    
    $self->{'_country'} = $collObject->country;
    $self->{'_oldcountry'} = $collObject->country;

    $self->{'_zip_code'} = $collObject->postalCode;
    $self->{'_oldzip_code'} = $collObject->postalCode;

    $self->{'_interests'} = $collObject->interest;
    $self->{'_oldinterests'} = $collObject->interest;

    $self->{'_Comments'} = $collObject->comment;
    $self->{'_oldComments'} = $collObject->comment;
    
    {
	my $arrayRef = $collObject->phoneRef;
	foreach my $rowRef (@$arrayRef) {
	    my ($phoneNum, $phoneType, $phoneLoc) = @$rowRef;
	    if ($phoneLoc !~ /unspecified/i) {
		$phoneType = $phoneLoc." ".$phoneType;
	    }
	    push(@$phoneRef, $phoneType." = ".$phoneNum);
	}
	@$oldphoneRef = @$phoneRef;
    }

    {
	my $arrayRef = $collObject->urlRef; 
	foreach my $rowRef (@$arrayRef) { 
	    my ($url, $wwwNm, $urlType) = @$rowRef;
	    push(@$urlRef, $url . "\t" . $wwwNm . "\t" . $urlType);
	}
	@$oldUrlRef = @$urlRef;
    }

    {
	my $arrayRef = $collObject->piRef;
	foreach my $rowRef (@$arrayRef) { 
	    my($collNo, $lname, $fname, $suffix) = @$rowRef;
	    push(@$piRef, $lname.", ".$fname);
	}
	@$oldpiRef = @$piRef;
    }

    {
	my $arrayRef = $collObject->associate4piRef; 
	foreach my $rowRef (@$arrayRef) { 
	    my($collNo, $lname, $fname, $suffix) = @$rowRef;
	    push(@$assocsByPiRef, $lname.", ".$fname);
	}
	@$oldassocsByPiRef = @$assocsByPiRef;
    }

    {
	my $arrayRef = $collObject->associateRef; 
	foreach my $rowRef (@$arrayRef) { 
	    my($collNo, $lname, $fname, $suffix) = @$rowRef;
	    push(@$assocsRef, $lname.", ".$fname);
	}
	@$oldassocsRef = @$assocsRef;
    }

    {
	my $arrayRef = $collObject->keywordRef; 
	foreach my $rowRef (@$arrayRef) { 
	    my ($keyword) = @$rowRef;
	    push(@$keywordRef, $keyword);
	}
	@$oldkeywordRef = @$keywordRef;
    }

    {
	my $arrayRef = $collObject->researchTopicsRef; 
	foreach my $rowRef (@$arrayRef) { 
	    my ($researchTopic) = @$rowRef;
	    $self->{'_researchTopics'} .= "\t" . $researchTopic;
	}
	$self->{'_researchTopics'} .= "\t";
	$self->{'_oldResearchTopics'} = $self->{'_researchTopics'};
    }

    {
	$self->{'_oldPIOnly'} = $collObject->isPIWithoutAssocs();
	$self->{'_newPIOnly'} = $collObject->isPIWithoutAssocs();
    }

    {
	$dbh = $collObject->dbh();
	my $arrayRef = $collObject->locusRef;
	my $lociList = "";
	foreach my $rowRef (@$arrayRef) {
	    (my $locusNo, undef) = @$rowRef;
	    $lociList .= "|" . $locusNo;
	}
	$lociList =~ s/^\|//;

	$self->{'_oldLoci'} = $self->{'_newLoci'} = $lociList;
    }
}

#######################################################################
sub populateInfo {
#######################################################################
    ## KD:  added stuff to deal with dictyBase contact
    my ($self, $phoneRef, $addrRef, $piRef, 
	$assocsByPiRef, $assocsRef, $keywordRef,
	$oldphoneRef, $oldaddrRef, $oldpiRef, 
	$oldassocsByPiRef, $oldassocsRef, $oldkeywordRef, 
	$urlRef, $oldUrlRef) = @_;
    my $id = param('id');
    if (-e "$dir/$id.MajorUpdate") {
	open(IN, "$dir/$id.MajorUpdate") || die "colleagueMajorUpdate: Can't open '$id.MajorUpdate' for reading:$!\n";
    }
    else {
	print "There is no file under $dir with the id ".font({-color=>'red'}, $id), p;
	exit;
    }
    my %oldValue;
    my %newValue;
    while(<IN>) {
	chomp;
	my ($name, $value) = split(/ = /);
	if (!$value) { next; }
	if ($name =~ /locus/i) { next; }
	if ($name =~ /(phone|fax|mobile|pager|telex)/i) {
	    if ($name =~ /^-D *(.+) *$/) {
		push(@$oldphoneRef, $1." = ".$value);
	    }
	    elsif ($name =~ /^\/\/ *(.+) *$/) {
		push(@$phoneRef, $1." = ".$value);
		push(@$oldphoneRef, $1." = ".$value);
	    }
	    else {
		push(@$phoneRef, $1." = ".$value);
	    }
	}	
	elsif ($name =~ /PI *\((.+)\) *$/i) {
	    if ($name =~ /^-D *PI *\((.+)\) *$/) {
		push(@$oldassocsByPiRef, $1);
	    }
	    elsif ($name =~ /^\/\/ *PI *\((.+)\) *$/) {
		push(@$assocsByPiRef, $1);
		push(@$oldassocsByPiRef, $1);
	    }
	    else {
		push(@$assocsByPiRef, $1);
	    }
	}
	elsif ($name =~ /^-D +(.+) *$/) {
	    my $oldName = "\U$1"; 
	    if ($oldName =~ /FIRST_NAME/i || $oldName =~ /LAST_NAME/i
		|| !$oldValue{$oldName}) {
		$oldValue{$oldName} = $value;
	    }
	    else {
		$oldValue{$oldName} = "$oldValue{$oldName}\t$value";
	    }
	}
	elsif ($name =~ /^\/\/ *(.+) *$/){
	    my $thisName = "\U$1";
	    if ($oldValue{$thisName}) {
		$oldValue{$thisName} .= "\t$value";
	    }
	    else {
		$oldValue{$thisName} = $value;
	    }
	    if ($newValue{$thisName}) {
		$newValue{$thisName} .= "\t$value";
	    }
	    else {
		$newValue{$thisName} = $value;
	    }
	}
	elsif ($name =~ /^ *(.+) *$/) {

	    my $newName = "\U$1";
	    if ($newName =~ /FIRST_NAME/i || $newName =~ /LAST_NAME/i 
		|| !$newValue{$newName}) {
		$newValue{$newName} = $value;
	    }
	    else {
		$newValue{$newName} .= "\t$value";
	    }
	}
    }
    close(IN);
    $self->{'_colleague_no'} = $newValue{"COLLEAGUE_NO"};
    #KD: adding dictyBase contact
    $self->{'_dictyBasecontact'} = $newValue{"CONTACT4dictyBase"};
    $self->{'_lname'} = $newValue{"LAST_NAME"};
    $self->{'_fname'} = $newValue{"FIRST_NAME"};
    $self->{'_suffix'} = $newValue{"SUFFIX"};
    $self->{'_oname'} = $newValue{"OTHER_NAME"};
    my $email = $newValue{"INTERNET"};
    $email =~ s/[,;]/ /g;
    $email =~ s/ +/ /g;
    &DeleteUnwantedChar(\$email);
    $self->{'_email'} = $email;
    $self->{'_institution'} = $newValue{"ORGANIZATION"};

    for (my $counter = 0; $counter < $maxNumURLs; $counter++) {
      my $urls = $newValue{"URL$counter"};
      $urls =~ s/[,;]/ /g;
      $urls =~ s/ +/ /g;

      push(@$urlRef, $urls 
	   . "\t" . $newValue{"WEBTITLE$counter"} 
	   . "\t" . $newValue{"URLTYPE$counter"});
    }

    @$addrRef = split(/\t/, $newValue{"ADDRESS"});
    $self->{'_city'} = $newValue{"CITY"};
    $self->{'_state'} = $newValue{"STATE"}; 
    $self->{'_region'} = $newValue{"REGION"};
    $self->{'_country'} = $newValue{"COUNTRY"}; 
    $self->{'_zip_code'} = $newValue{"POSTALCODE"};  
    $self->{'_jobtitle'} = $newValue{"JOBTITLE"};  
    $self->{'_profession'} = $newValue{"PROFESSION"}; 
    @$piRef = split(/\t/, $newValue{"HEAD_OF_LAB"});
    @$assocsRef = split(/\t/, $newValue{"ASSOCIATE"});
    $self->{'_interests'} = $newValue{"RESEARCH_INTEREST"};
    $self->{'_researchTopics'} = $newValue{"RESEARCHTOPICS"};
    @$keywordRef = split(/\t/, $newValue{"KEYWORD"});
    $self->{'_Comments'} = $newValue{"COMMENTS"};
    
    $self->{'_oldlname'} = $oldValue{"LAST_NAME"};
    $self->{'_oldfname'} = $oldValue{"FIRST_NAME"};
    $self->{'_oldsuffix'} = $oldValue{"SUFFIX"};
    $self->{'_oldoname'} = $oldValue{"OTHER_NAME"};
    $self->{'_olddictyBasecontact'} = $oldValue{"CONTACT4dictyBase"};

    my $oldemail = $oldValue{"INTERNET"};
    $oldemail =~ s/[,;]/ /g;
    $oldemail =~ s/ +/ /g;
    &DeleteUnwantedChar(\$oldemail);
    $self->{'_oldemail'} = $oldemail;
    $self->{'_oldinstitution'} = $oldValue{"ORGANIZATION"};

    for (my $counter = 0; $counter < $maxNumURLs; $counter++) {
      my $oldurls = $oldValue{"URL$counter"};
      $oldurls =~ s/[,;]/ /g;
      $oldurls =~ s/ +/ /g;

      push(@$oldUrlRef, $oldurls 
	   . "\t" . $oldValue{"WEBTITLE$counter"} 
	   . "\t" . $oldValue{"URLTYPE$counter"})
    }

    @$oldaddrRef = split(/\t/, $oldValue{"ADDRESS"});
    $self->{'_oldcity'} = $oldValue{"CITY"};
    $self->{'_oldstate'} = $oldValue{"STATE"}; 
    $self->{'_oldregion'} = $oldValue{"REGION"}; 
    $self->{'_oldcountry'} = $oldValue{"COUNTRY"}; 
    $self->{'_oldzip_code'} = $oldValue{"POSTALCODE"};  
    $self->{'_oldjobtitle'} = $oldValue{"JOBTITLE"};  
    $self->{'_oldprofession'} = $oldValue{"PROFESSION"};  
    @$oldpiRef = split(/\t/, $oldValue{"HEAD_OF_LAB"});
    @$oldassocsRef = split(/\t/, $oldValue{"ASSOCIATE"});
    $self->{'_oldinterests'} = $oldValue{"RESEARCH_INTEREST"};
    $self->{'_oldResearchTopics'} = $oldValue{"RESEARCHTOPICS"};
    @$oldkeywordRef = split(/\t/, $oldValue{"KEYWORD"});
    $self->{'_oldComments'} = $oldValue{"COMMENTS"};

    $self->{'_oldPIOnly'} = $self->{'_newPIOnly'} = $oldValue{"PIONLY"};

    { # read associated loci information the file
	# translate locus_no into locus_name
	my $lociList = $newValue{"ASSOCIATED_LOCI"};
	$self->{'_oldLoci'} = $lociList;
	$self->{'_newLoci'} = $lociList;
    }
}

########################################################################
sub processData {
########################################################################
    my ($self) = @_;
    ## KD: adding contact stuff ***
    my $value = param('dictyBasecontact');
    &DeleteUnwantedChar(\$value);
    $self->{'_dictyBasecontact'} = $value;

    my $value = param('lname');
    &DeleteUnwantedChar(\$value);
    $self->{'_lname'} = $value;
    
    $value = param('fname');
    &DeleteUnwantedChar(\$value);
    $self->{'_fname'} = $value;
 
    $value = param('suffix');
    &DeleteUnwantedChar(\$value);
    $self->{'_suffix'} = $value;
 
    $value = param('oname');
    &DeleteUnwantedChar(\$value);
    $self->{'_oname'} = $value;

    $value = param('profession');
    &DeleteUnwantedChar(\$value);
    $self->{'_profession'} = $value;

    $value = param('jobtitle');
    &DeleteUnwantedChar(\$value);
    $self->{'_jobtitle'} = $value;

    $value = param('institution');
    &DeleteUnwantedChar(\$value);
    $self->{'_institution'} = $value;
    my $j;
    for (my $i = 1; $i <= 5; $i++) {
	$value = param("addr$i");
	&DeleteUnwantedChar(\$value);
	if ($value) {
	    $j++;
	    $self->{"_address$j"} = $value;
	}
    }
    $value = param('city');
    &DeleteUnwantedChar(\$value);
    $self->{'_city'} = $value;

    if (param('USAstate') && param('USAstate') !~ /^USA State/i) {
	$self->{'_state'} = param('USAstate');
    }
    elsif (param('CanadaPro') !~ /^Canadian Province/i)  {
	$self->{'_state'} = param('CanadaPro');
    }

    $value = param('region');
    &DeleteUnwantedChar(\$value);
    $self->{'_region'} = $value;
 
    $value = param('country');
    &DeleteUnwantedChar(\$value);
    $self->{'_country'} = $value;

    $value = param('zip_code');
    &DeleteUnwantedChar(\$value);
    $self->{'_zip_code'} = $value;
}

#######################################################################
sub getSetStatement {
#######################################################################
    my ($self, $collObject) = @_;
    my $setStatement = "";

    if ($collObject->lname) {
	my $lname = $self->{'_lname'};
	$lname =~ s/\'/\'\'/g;
	$setStatement .= "last_name = '${lname}', ";
    }
    
    if ($collObject->fname) {
	my $fname = $self->{'_fname'};
	$fname =~ s/\'/\'\'/g;
	$setStatement .= "first_name = '${fname}', ";
    }
    if ($self->{'_suffix'}) {
	my $suffix = $self->{'_suffix'};
	$setStatement .= "suffix = '${suffix}', ";
    }
    elsif ($collObject->suffix) {
	$setStatement .= "suffix = NULL, ";
    }
    if ($self->{'_oname'}) {
	my $oname = $self->{'_oname'};
	$oname =~ s/\'/\'\'/g;
	$setStatement .= "other_name = '${oname}', ";
    }
    elsif ($collObject->oname) {
	$setStatement .= "other_name = NULL, ";
    }
    if ($self->{'_profession'}) {
	my $profession = $self->{'_profession'};
	$profession =~ s/\'/\'\'/g;
	$setStatement .= "profession = '${profession}', ";
    }
    elsif ($collObject->profession) {
	$setStatement .= "profession = NULL, ";
    }
    ## KD: contact stuff ***
    if ($self->{'_dictyBasecontact'}) {
	my $dictyBasecontact = $self->{'_dictyBasecontact'};
	$dictyBasecontact =~ s/\'/\'\'/g;
	$setStatement .= "is_subscribed = '${dictyBasecontact}', ";
    }

    if ($self->{'_jobtitle'}) {
	my $jobtitle = $self->{'_jobtitle'};
	$jobtitle =~ s/\'/\'\'/g;
	$setStatement .= "job_title = '${jobtitle}', ";
    }
    elsif ($collObject->jobTitle) {
	$setStatement .= "job_title = NULL, ";
    }
    if ($self->{'_institution'}) {
	my $institution = $self->{'_institution'};
        $institution =~ s/\'/\'\'/g;
	$setStatement .= "institution = '${institution}', ";
    }
    elsif ($collObject->institution) {
	$setStatement .= "institution = NULL, ";
    }

    my @oldaddr = ("", $collObject->address1, $collObject->address2,
		   $collObject->address3, $collObject->address4,
		   $collObject->address5);
    for (my $i = 1; $i <= 5; $i++) {
	my $newaddr = $self->{"_address$i"};
	$newaddr =~ s/\'/\'\'/g;
	if ($newaddr) {
	    $setStatement .= "address$i = '$newaddr', ";
	}
	elsif ($oldaddr[$i]) {
	    $setStatement .= "address$i = NULL, ";
	}
    }
    if ($self->{'_city'}) {
	my $city = $self->{'_city'};
	$city =~ s/\'/\'\'/g;
	$setStatement .= "city = '${city}', ";
    }
    elsif ($collObject->city) {
	$setStatement .= "city = NULL, ";
    }
    if ($self->{'_state'}) {
	my $state = $self->{'_state'};
	$state =~ s/\'/\'\'/g;
	$setStatement .= "state = '${state}', ";
    }
    elsif ($collObject->state) {
	$setStatement .= "state = NULL, ";
    }
    if ($self->{'_region'}) {
	my $region = $self->{'_region'};
	$region =~ s/\'/\'\'/g;
	$setStatement .= "region = '${region}', ";
    }
    elsif ($collObject->region) {
	$setStatement .= "region = NULL, ";
    }
    if ($self->{'_country'}) {
	my $country = $self->{'_country'};
        $country =~ s/\'/\'\'/g;
	$setStatement .= "country = '${country}', ";
    }
    elsif ($collObject->country) {
	$setStatement .= "country = NULL, ";
    }
    if ($self->{'_zip_code'}) {
	my $zip_code = $self->{'_zip_code'};
        $zip_code =~ s/\'/\'\'/g;
	$setStatement .= "postal_code = '${zip_code}', ";
    }
    elsif ($collObject->postalCode) {
	$setStatement .= "postal_code = NULL, ";
    }
    $setStatement .= "date_modified = sysdate, ";
    $setStatement .= "source = 'Direct Submission'";

    $setStatement =~ s/, $//;
    return ($setStatement);
}


########################################################################
sub err_report {
########################################################################
    my ($self, $err) = @_;

    &printStartPage($self->database, $self->title, $self->help);
   
    print b($err);
    
    &printEndPage;

    exit;
}

###################################################################
1;
###################################################################