delete $dir/$file failed: $!
";
}
else {
print "
$file has been deleted from $dir directory.
";
}
}
#####################################################################
sub delayFile {
#####################################################################
my ($id, $dir, $delayComment, $user) = @_;
my $delayfile = "$dir/delay.list";
if (open(OUT, ">>$delayfile")) {
print OUT "${id}\tdelay by ${user}";
if ($delayComment) {
print OUT ", $delayComment";
}
print OUT "\n";
print p, b("The data has been returned to the list with delay mark."), br;
}
else {
print p,b("Can't open '$delayfile' for appending: ".$!), br;
}
}
#####################################################################
sub returnForm {
#####################################################################
my ($user, $dblink) = @_;
$user = "\L$user";
$user =~ tr/[a-z]/[A-Z]/;
my $btnURL = $configUrl->dictyBaseCGIRoot."$dblink/curatorLogin";
print start_form(-action=>$configUrl->dictyBaseCGIRoot."$dblink/curatorLogin",
-method=>"post"),
hidden(-name=>'type',
-value=>'colleague'),
hidden(-name=>'user',
-value=>"$user"),
submit(-name=>'Submit',
-value=>'Go back to list of entries'),
input({-type=>"button",
-value=>"Return to Curator Central",
-onClick=>"window.location\='$btnURL?user=${user}';"}),
endform;
}
########################################################################
###### deleteColleagueEntryBYid() is used to delete all related colleague
###### info for specified colleague_no
###### Usage : &deleteColleagueEntryBYid($dbh, $colleague_id);
######
########################################################################
sub deleteColleagueEntryBYid {
#########################################################################
my ($dbh, $id) = @_;
my $sth = $dbh->prepare("
DELETE from CGM_DDB.colleague
WHERE colleague_no = ?
");
$sth->execute($id);
}
########################################################################
##### insertEmails() is used to insert new email addresses into coll_email
##### and email tables
##### usage: insertEmails($dbh, $colleague_no, $user, @emails);
########################################################################
sub insertEmails {
########################################################################
my ($dbh, $colleague_id, $dbuser, @emails) = @_;
if ($#emails < 0) { return; }
foreach my $email (@emails) {
$email =~ s/[\t\n\r\f]//g;
my $TMPemail = "\U$email";
my $sth = $dbh->prepare( "
SELECT email_no
FROM CGM_DDB.email
WHERE upper(email) = ?
");
$sth->execute($TMPemail);
my $email_no = $sth->fetchrow;
if (!$email_no) {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.email(email_no, email, created_by)
VALUES (CGM_DDB.emailno_seq.nextval,?,?)
");
$sth->execute($email, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_email(colleague_no, email_no)
VALUES (?, CGM_DDB.emailno_seq.currval)
");
$sth->execute($colleague_id);
}
else {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_email(colleague_no, email_no)
VALUES (?,?)
");
$sth->execute($colleague_id, $email_no);
}
}
}
#######################################################################
##### insertUrls() is used to insert new url addresses into coll_url
##### and url tables
##### usage: insertUrls($dbh, $colleague_no, $user, @urls);
#######################################################################
sub insertUrls {
#######################################################################
my ($dbh, $colleague_id, $dbuser, $urlObject) = @_;
# if ($#urls < 0) { return; }
my ($url, $www, $url_type) = split(/\t/, $urlObject);
$url =~ s/[\t\n\r\f]//g;
my $sth = $dbh->prepare( "
SELECT url_no
FROM CGM_DDB.url
WHERE url = ?
AND url_type = ?
");
$sth->execute($url, $url_type);
my $url_no = $sth->fetchrow;
if (!$url_no) {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.url(url_no, url, www_name,
url_type, created_by)
VALUES (CGM_DDB.urlno_seq.nextval, ?, ?,
?, ?)
");
if ($url_type ne "Please specify") {
$sth->execute($url, $www, $url_type, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_url(colleague_no, url_no)
VALUES (?, CGM_DDB.urlno_seq.currval)
");
$sth->execute($colleague_id);
}
}
else {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_url(colleague_no, url_no)
VALUES (?,?)
");
$sth->execute($colleague_id, $url_no);
}
}
########################################################################
##### insertPi() is used to insert pi info into colleague, pi and
##### associate tables
##### usage: insertPi($dbh, $colleague_no, $user, $pi);
########################################################################
sub insertPi {
########################################################################
my ($dbh, $colleague_id, $dbuser, $pi, $isdictyBaseContact) = @_;
$pi =~ s/\, */\,/g;
my ($pilname, $pifname, $pisuffix) = split(/\,/, $pi);
my $sth;
my @id = &getColleagueNoBYname($dbh, $pilname,
$pifname, $pisuffix);
if (!$isdictyBaseContact) { $isdictyBaseContact = 'N'; }
my $picolleague_no = $id[0];
if (!$picolleague_no) {
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.colleague(colleague_no,
last_name, first_name, suffix,
date_modified, date_created,
created_by, source, is_subscribed)
VALUES (CGM_DDB.collno_seq.nextval, ?,?,?,
sysdate, sysdate, ?, 'Associate', ?)
");
$sth->execute($pilname, $pifname, $pisuffix, $dbuser,
$isdictyBaseContact);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.pi(colleague_no, pi_no,
created_by)
VALUES (?, CGM_DDB.collno_seq.currval, ?)
");
$sth->execute($colleague_id, $dbuser);
}
else {
$sth = $dbh->prepare( "
SELECT pi_no
FROM CGM_DDB.pi
WHERE colleague_no = ?
");
$sth->execute($colleague_id);
my $found = 0;
while(my ($number) = $sth->fetchrow()) {
if ($number == $picolleague_no) {
$found = 1;
}
}
if ($found == 0) {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.pi(colleague_no, pi_no,
created_by)
VALUES (?,?,?)
");
$sth->execute($colleague_id,$picolleague_no,$dbuser);
}
}
}
######################################################################
##### insertAssocsBYpi() is used to insert associates info into
##### colleague, pi and associate tables
##### usage: insertAssocsBYpi($dbh, $colleague_no, $user, @assocs);
######################################################################
sub insertAssocsBYpi {
######################################################################
my ($dbh, $colleague_id, $dbuser, @assocs) = @_;
if ($#assocs < 0) { return; }
foreach my $assoc (@assocs) {
$assoc =~ s/\, */\,/g;
my ($alname, $afname, $asuffix) = split(/\,/, $assoc);
my $sth;
my @id = &getColleagueNoBYname($dbh, $alname,
$afname, $asuffix);
my $Acolleague_no = $id[0];
if (!$Acolleague_no) {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.colleague(colleague_no,
last_name, first_name, suffix,
date_modified, date_created,
created_by, source, is_subscribed)
VALUES (CGM_DDB.collno_seq.nextval, ?,?,?,
sysdate, sysdate, ?,'Associate', 'N')
");
$sth->execute($alname, $afname, $asuffix, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.pi(colleague_no, pi_no,
created_by)
VALUES (CGM_DDB.collno_seq.currval,?,?)
");
$sth->execute($colleague_id, $dbuser);
}
else {
my $sth = $dbh->prepare( "
SELECT pi_no
FROM CGM_DDB.pi
WHERE colleague_no = ?
");
$sth->execute($Acolleague_no);
my $found = 0;
while(my ($number) = $sth->fetchrow()) {
if ($number == $colleague_id) {
$found = 1;
}
}
if ($found == 0) {
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.pi(colleague_no, pi_no,
created_by)
VALUES (?,?,?)
");
$sth->execute($Acolleague_no, $colleague_id,
$dbuser);
}
}
}
}
########################################################################
##### insertAssocs() is used to insert associates info into colleague
##### and associate tables
##### usage: insertAssocs($dbh, $colleague_no, $user, @assocs);
########################################################################
sub insertAssocs {
########################################################################
my ($dbh, $colleague_id, $dbuser, @assocs) = @_;
if ($#assocs < 0) { return; }
foreach my $assoc (@assocs) {
$assoc =~ s/\, */\,/g;
my ($alname, $afname, $asuffix) = split(/\,/, $assoc);
my $sth;
my @id = &getColleagueNoBYname($dbh, $alname,
$afname, $asuffix);
my $Acolleague_no = $id[0];
if (!$Acolleague_no) {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.colleague(colleague_no,
last_name, first_name, suffix,
date_modified, date_created,
created_by, source, is_subscribed)
VALUES (CGM_DDB.collno_seq.nextval, ?,?,?,
sysdate, sysdate, ?, 'Associate', 'N')
");
$sth->execute($alname, $afname, $asuffix, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.associate(colleague_no,
associate_no, created_by)
VALUES (CGM_DDB.collno_seq.currval, ?,?)
");
$sth->execute($colleague_id, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.associate(colleague_no,
associate_no, created_by)
VALUES (?, CGM_DDB.collno_seq.currval, ?)
");
$sth->execute($colleague_id, $dbuser);
}
else {
my $sth = $dbh->prepare( "
SELECT associate_no
FROM CGM_DDB.associate
WHERE colleague_no = ?
");
$sth->execute($Acolleague_no);
my $found = 0;
while(my ($number) = $sth->fetchrow()) {
if ($number == $colleague_id) {
$found = 1;
}
}
if ($found == 0) {
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.associate(colleague_no,
associate_no, created_by)
VALUES (?,?,?)
");
$sth->execute($Acolleague_no, $colleague_id,
$dbuser);
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.associate(colleague_no,
associate_no, created_by)
VALUES (?,?,?)
");
$sth->execute($colleague_id, $Acolleague_no,
$dbuser);
}
}
}
}
########################################################################
##### updateGenericAssociate() is used to associate a given
##### colleague with the associate named "~Generic ~Associate", as a
##### student, post-doc or technician. This treats the colleague as
##### as PI in the database; and allows them to be displayed on the
##### Dictyostelium Labs page.
########################################################################
sub updateGenericAssociate {
########################################################################
my ($dbh, $colleague_id, $dbuser, $setFlag, @assocs) = @_;
### Local variable declaration
my $sth;
my $genericAssociateColleagueNo;
### Check to see if this PI has any lab members.
# if this PI already has lab members, then no need to associate him
# with ~Generic ~Associate
if (scalar @assocs > 0) {
$setFlag = "false"; # remove existing association with ~Generic ~Assoc
}
### determine the colleague number of ~Generic ~Associate
$sth = $dbh->prepare("
SELECT colleague_no
FROM CGM_DDB.colleague
WHERE last_name = '~Associate'
AND first_name = '~Generic'
");
$sth->execute();
if (($genericAssociateColleagueNo) = $sth->fetchrow()) {
}
else {
# Unable to locate the colleague_id for ~Generic ~Associate
# An error message should be thrown here
return;
}
### Error testing
# should not be attempting to add ~Generic ~Associate as a member of its
# own lab.
if ($colleague_id == $genericAssociateColleagueNo) {
return;
}
my $returnCode = 0;
### Determine if the current PI is already associted with ~Generic ~Associ
# or not
$sth = $dbh->prepare("
SELECT *
FROM CGM_DDB.pi
WHERE colleague_no = ?
AND pi_no = ?
");
$sth->execute($genericAssociateColleagueNo, $colleague_id);
if (my $dummy = $sth->fetchrow) {
# Already associated with ~G~A
if ($setFlag eq "false") {
# remove this row of CGM_DDB.pi
$sth = $dbh->prepare("
DELETE
FROM CGM_DDB.pi
WHERE colleague_no = ?
AND pi_no = ?
");
$sth->execute($genericAssociateColleagueNo, $colleague_id);
$returnCode++;
}
else {
# no need to reassociate this PI with ~G~A
}
}
else {
# Not already associated with ~G~A
if ($setFlag eq "true") {
# Add an association between this PI and ~G~A
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.pi(colleague_no, pi_no)
VALUES (?, ?)
");
$sth->execute($genericAssociateColleagueNo, $colleague_id);
$returnCode++;
}
else {
# no need to remove a non-existant associate between this PI and
# ~G~A
}
}
return $returnCode;
}
########################################################################
##### insertKeywords() is used to insert keyword info into coll_keyword
##### and keyword tables
##### usage: insertKeywords($dbh, $colleague_no, $user, @keywords);
########################################################################
sub insertKeywords {
########################################################################
my ($dbh, $colleague_id, $dbuser, @keywords) = @_;
if ($#keywords < 0) { return; }
foreach my $keyword (@keywords) {
my $tmpkeyword = "\U$keyword";
my $sth = $dbh->prepare( "
SELECT keyword_no
FROM CGM_DDB.keyword
WHERE upper(keyword) = ?
AND source = 'Colleague Keyword'
");
$sth->execute($tmpkeyword);
my $found = 0;
my $keyword_no;
while(my ($number) = $sth->fetchrow()) {
$found = 1;
$keyword_no = $number;
}
my $tmpsource = "Colleague Keyword";
if ($found == 0) {
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.keyword(keyword_no,
keyword, source, created_by)
VALUES (CGM_DDB.kwno_seq.nextval, ?,
'Colleague Keyword', ?)
");
$sth->execute($keyword, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_keyword(colleague_no,
keyword_no)
VALUES (?, CGM_DDB.kwno_seq.currval)
");
$sth->execute($colleague_id);
}
else {
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_keyword(colleague_no,
keyword_no)
VALUES (?,?)
");
$sth->execute($colleague_id, $keyword_no);
}
}
}
#######################################################################
##### insertComments() is used to insert user comments or research
##### interest into colleague_remark table
##### usage: insertComments($dbh, $colleague_no, $user, $comments,
##### $type);
#######################################################################
sub insertComments {
#######################################################################
my ($dbh, $colleague_id, $dbuser, $comment, $type) = @_;
$comment =~ s/\n/\\n/g;
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.colleague_remark(remark_no, remark,
remark_type, colleague_no, created_by)
VALUES (CGM_DDB.remarkno_seq.nextval, ?,?,?,?)
");
$sth->execute($comment, $type, $colleague_id, $dbuser);
}
#######################################################################
##### insertAssociatedLoci() is used to insert associated loci
##### into the coll_locus table
##### usage: insertComments($dbh, $colleague_no, @associatedLoci );
#######################################################################
sub insertAssociatedLoci {
#######################################################################
my ($dbh, $colleague_id, @associatedLoci) = @_;
if ($#associatedLoci < 0 ) { return; }
foreach my $locusNo (@associatedLoci) {
# print "\$locus_no = ", $locusNo, " -- \$colleague_no = ", $colleague_id, "\n", br;
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_locus(LOCUS_NO, COLLEAGUE_NO)
VALUES (?, ?)
");
$sth->execute($locusNo, $colleague_id);
}
}
#######################################################################
##### insertCuratorNote() is used to insert curator note into
##### curator_not and coll_cn tables
##### usage: insertCuratorNote($dbh, $colleague_no, $user, $note);
#######################################################################
sub insertCuratorNote{
#######################################################################
my ($dbh, $colleague_id, $dbuser, $note, $is_public) = @_;
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.curator_note(curator_note_no, note,
is_public, created_by)
VALUES (CGM_DDB.cnno_seq.nextval, ?,?,?)
");
$sth->execute($note, $is_public, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_cn(curator_note_no, colleague_no)
VALUES (CGM_DDB.cnno_seq.currval,?)
");
$sth->execute($colleague_id);
}
#######################################################################
##### updateCuratorNote() is used to update curator note in curator_note
##### and coll_cn tables
##### usage: updateCuratorNote($dbh, $colleague_no, $user, $newnote,
##### $oldnote, $isPublic);
#######################################################################
sub updateCuratorNote{
#######################################################################
my ($dbh, $colleague_id, $dbuser, $newnote, $oldnote,
$is_public)= @_;
if ($oldnote) {
my $sth = $dbh->prepare( "
SELECT N.curator_note_no
FROM CGM_DDB.coll_cn CN, CGM_DDB.curator_note N
WHERE CN.colleague_no = ?
AND N.note = ?
AND N.curator_note_no = CN.curator_note_no
");
$sth->execute($colleague_id, $oldnote);
my $found = 0;
my $curator_note_no;
while(my ($number) = $sth->fetchrow()) {
$found++;
$curator_note_no = $number;
}
if ($found != 0) {
if ($newnote) {
$sth = $dbh->prepare("
UPDATE CGM_DDB.curator_note
SET note = ?,
is_public = ?
WHERE curator_note_no = ?
");
$sth->execute($newnote, $is_public,
$curator_note_no);
}
else {
$sth = $dbh->prepare("
DELETE from CGM_DDB.coll_cn
WHERE coll_cn.colleague_no = ?
");
$sth->execute($colleague_id);
$dbh->commit;
$sth = $dbh->prepare("
DELETE from CGM_DDB.curator_note
WHERE curator_note_no = ?
");
$sth->execute($curator_note_no);
}
}
}
elsif ($newnote) {
my $sth = $dbh->prepare("
INSERT INTO CGM_DDB.curator_note(curator_note_no, note,
is_public, created_by)
VALUES (CGM_DDB.cnno_seq.nextval, ?,?,?)
");
$sth->execute($newnote, $is_public, $dbuser);
$dbh->commit;
$sth = $dbh->prepare("
INSERT INTO CGM_DDB.coll_cn(curator_note_no,
colleague_no)
VALUES (CGM_DDB.cnno_seq.currval, ?)
");
$sth->execute($colleague_id);
}
}
########################################################################
##### deleteAssocsBYpi() is used to delete associates info from pi and
##### colleague table
##### usage: deleteAssocsBYpi($dbh, $colleague_no, @assocs);
########################################################################
sub deleteAssocsBYpi {
########################################################################
my ($dbh, $colleague_id, $Acolleague_no) = @_;
if (!$Acolleague_no) { return; }
my $sth = $dbh->prepare("
DELETE from CGM_DDB.pi
WHERE colleague_no = ?
AND pi_no = ?
");
$sth->execute($Acolleague_no, $colleague_id);
$dbh->commit;
#### check if this associate info is still in the pi
#### or associate tables or if it has an email address
#### associated with. If not, delete it from
#### colleague table, else keep it.
my $found = 0;
$sth = $dbh->prepare( "
SELECT colleague_no
FROM CGM_DDB.pi
WHERE colleague_no = ?
OR pi_no = ?
");
$sth->execute($Acolleague_no, $Acolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
if ($found == 0) {
my $sth = $dbh->prepare( "
SELECT colleague_no
FROM CGM_DDB.associate
WHERE colleague_no = ?
OR associate_no = ?
");
$sth->execute($Acolleague_no, $Acolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
}
if ($found == 0) {
my $sth = $dbh->prepare( "
SELECT email_no
FROM CGM_DDB.coll_email
WHERE colleague_no = ?
");
$sth->execute($Acolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
}
#### if no any info associated with this associate,
#### i.e.,
#### # not a pi and not associated with any other
#### colleague and no any email address, DELETE it from
#### colleague table
if ($found == 0) {
my $sth = $dbh->prepare("
DELETE from CGM_DDB.colleague
WHERE colleague_no = ?
");
$sth->execute($Acolleague_no);
$dbh->commit;
}
}
##########################################################################
##### deleteAssocs() is used to delete associates info from associate and
##### colleague table
##### usage: deleteAssocs($dbh, $colleague_no, @assocs);
##########################################################################
sub deleteAssocs {
##########################################################################
my ($dbh, $colleague_id, $Acolleague_no) = @_;
if (!$Acolleague_no) { return; }
my $sth = $dbh->prepare("
DELETE from CGM_DDB.associate
WHERE (colleague_no = ? and
associate_no = ?) or
(colleague_no = ? and
associate_no = ?)
");
$sth->execute($Acolleague_no, $colleague_id,
$colleague_id, $Acolleague_no);
$dbh->commit;
#### check if this associate info is still in the pi
#### or associate tables or if it has an email address
#### associated with. If not, delete it from
#### colleague table, else keep it.
my $found = 0;
$sth = $dbh->prepare( "
SELECT colleague_no
FROM CGM_DDB.pi
WHERE colleague_no = ? or
pi_no = ?
");
$sth->execute($Acolleague_no, $Acolleague_no);
while(my($number) = $sth->fetchrow()) {
$found++;
}
if ($found == 0) {
my $sth = $dbh->prepare( "
SELECT colleague_no
FROM CGM_DDB.associate
WHERE colleague_no = ? or
associate_no = ?
");
$sth->execute($Acolleague_no, $Acolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
}
if ($found == 0) {
my $sth = $dbh->prepare( "
SELECT email_no
FROM CGM_DDB.coll_email
WHERE colleague_no = ?
");
$sth->execute($Acolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
}
#### if no any info associated with this associate, i.e.,
#### # not a pi and not associated with any other
#### colleague and no any email address, DELETE it from
#### colleague table
if ($found == 0) {
my $sth = $dbh->prepare("
DELETE from CGM_DDB.colleague
WHERE colleague_no = ?
");
$sth->execute($Acolleague_no);
$dbh->commit;
}
}
#################################################################
sub deletePi {
#################################################################
my ($dbh, $colleague_id, $alname, $afname, $asuffix) = @_;
my @id = &getColleagueNoBYname($dbh, $alname,
$afname, $asuffix);
my $PIcolleague_no = $id[0];
if (!$PIcolleague_no) { return;}
my $sth = $dbh->prepare("
DELETE from CGM_DDB.pi
WHERE pi_no = ?
AND colleague_no = ?
");
$sth->execute($PIcolleague_no, $colleague_id);
$dbh->commit;
#### check if this pi info is still in the pi table
#### or associate table or if it has an email address
#### associated with. If not, delete it from
#### colleague table, else keep it.
my $found;
$sth = $dbh->prepare( "
SELECT colleague_no
FROM CGM_DDB.pi
WHERE pi_no = ?
");
$sth->execute($PIcolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
if (!$found) {
my $sth = $dbh->prepare( "
SELECT colleague_no
FROM CGM_DDB.associate
WHERE colleague_no = ?
OR associate_no = ?
");
$sth->execute($PIcolleague_no, $PIcolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
}
if (!$found) {
my $sth = $dbh->prepare( "
SELECT email_no
FROM CGM_DDB.coll_email
WHERE colleague_no = ?
");
$sth->execute($PIcolleague_no);
while(my ($number) = $sth->fetchrow()) {
$found++;
}
#### if no any info associated with this pi, i.e.,
#### # not a pi anymore and not associated with any other
#### colleague and no any email address, DELETE it from
#### colleague table
if (!$found) {
$sth = $dbh->prepare("
DELETE from CGM_DDB.colleague
WHERE colleague_no = ?
");
$sth->execute($PIcolleague_no);
$dbh->commit;
}
}
}
#########################################################################
##### deleteKeywords() is used to delete keyword info from coll_keyword
##### and keyword tables
##### usage: deleteKeywords($dbh, $colleague_no, @keywords);
#########################################################################
sub deleteKeywords {
#########################################################################
my ($dbh, $colleague_id, @keywords) = @_;
if ($#keywords < 0) { return; }
foreach my $keyword (@keywords) {
my $tmpkeyword = "\U$keyword";
my $sth = $dbh->prepare( "
SELECT keyword_no
FROM CGM_DDB.keyword
WHERE upper(keyword) = ?
and source = 'Colleague Keyword'
");
$sth->execute($tmpkeyword);
my $found = 0;
my $keyword_no;
while(my ($number) = $sth->fetchrow()) {
$found = 1;
$keyword_no = $number;
}
if ($found != 0) {
$sth = $dbh->prepare("
DELETE from CGM_DDB.coll_keyword
WHERE colleague_no = ? and
keyword_no = ?
");
$sth->execute($colleague_id, $keyword_no);
$dbh->commit;
}
}
}
########################################################################
##### orderAssociates() is used to put two lists of associates so that
##### matching associates are in the correct position.
##### usage: insertAssocs(\@oldAssoc, \@assocs);
########################################################################
sub orderAssociates {
########################################################################
my ($oldAssocRef, $newAssocRef) = @_;
my (@newAssoc, @oldAssoc);
if (!$$oldAssocRef[0] || !$$newAssocRef[0]) {
return ($oldAssocRef, $newAssocRef);
}
@newAssoc = @$newAssocRef;
@oldAssoc = @$oldAssocRef;
my %allAssocs;
foreach my $newAssoc (@newAssoc) {
$allAssocs{$newAssoc} = 1;
}
@newAssoc = ();
foreach my $oldAssoc(@oldAssoc) {
$allAssocs{$oldAssoc} = defined $allAssocs{$oldAssoc} ? 11 : 10;
}
@oldAssoc = ();
my @sameAssocs = ();
my @addedAssocs = ();
my @removedAssocs = ();
foreach my $assoc (sort keys %allAssocs) {
if ($allAssocs{$assoc} eq 10) {
push (@removedAssocs, $assoc);
}
elsif ($allAssocs{$assoc} eq 01) {
push (@addedAssocs, $assoc);
}
else {
push (@sameAssocs, $assoc);
}
}
foreach my $sameAssoc (@sameAssocs) {
push (@newAssoc, $sameAssoc);
push (@oldAssoc, $sameAssoc);
}
foreach my $addAssoc (@addedAssocs) {
push (@newAssoc, $addAssoc);
}
foreach my $remAssoc (@removedAssocs) {
push (@oldAssoc, $remAssoc);
}
return (\@oldAssoc, \@newAssoc);
}
#####################################################################
1; ##### Return it to the calling program
#####################################################################