#!/usr/bin/perl
package UpdateColleague_base;
#######################################################################
##### 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:20 $
# $Header: /projects/dicty/build/source_files/db/lib/site_name/curation/UpdateColleague_base.pm,v 1.7 2010/08/31 18:58:20 emj466 Exp $
# $Log: UpdateColleague_base.pm,v $
# Revision 1.7  2010/08/31 18:58:20  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.6.20.1  2010/08/31 16:54:21  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.6.24.1  2010/08/30 21:04:15  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.6  2007/06/19 15:11:13  emj466
# substitute @@_dbuser_ @@ for cgm_ddb
#
# Revision 1.5  2007/03/12 19:37:11  emj466
# have to uppercase hash key to make retro compatilbe
#
# Revision 1.4  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.3  2006/10/26 20:24:28  emj466
# define data directory in base class
#
# 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.46.1  2006/09/27 18:15:39  smerchant
# Added finish statement
#
# Revision 1.1.1.3  2006/09/27 18:13:04  smerchant
# Added finish statement
#
# 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.25  2003/07/25 16:55:46  shuai
# *** empty log message ***
#
# 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.7 $
# $Source: /projects/dicty/build/source_files/db/lib/site_name/curation/UpdateColleague_base.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 #################################
#######################################################################

our $dbh;
our $dblink;
our $dbname;
our $dir;

our $maxNumURLs = 3;

our $configUrl = ConfigURLdictyBase->new;

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

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

        my $self = {};
        bless $self, $type;

              $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;
            }
}
#
# changed directory to look for updates to the same one that is
#  configured on the user side : $configPath->dataDir4web."submission/colleague"
#
#
######################################################################
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: http://dictybase.org/db/cgi-bin/$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: http://dictybase.org/db/cgi-bin/$dblink/curatorLogin\n";
	    print "Content-type: text/html\n\n";
	    exit;
	}
	$dir = "/usr/local/dicty/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;

    }

    $sth->finish();
}

#######################################################################
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++;
        $sth->finish();
    }
    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++;
        $sth->finish();
    }
    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++;
        $sth->finish();
    }
    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++;
        $sth->finish();
    }
    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{uc("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{uc("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;
###################################################################