Revision 4378
Added by walbridge about 16 years ago
| src/perl/register-dataset.cgi | ||
|---|---|---|
| 30 | 30 |
|
| 31 | 31 |
use lib '../WEB-INF/lib'; |
| 32 | 32 |
use Metacat; |
| 33 |
use AppConfig qw(:expand :argcount); |
|
| 34 | 33 |
use Config::Properties; |
| 35 | 34 |
use Cwd 'abs_path'; |
| 36 | 35 |
use XML::LibXML; |
| ... | ... | |
| 77 | 76 |
my $styleSkinsPath = $contextUrl . "/style/skins"; |
| 78 | 77 |
my $styleCommonPath = $contextUrl . "/style/common"; |
| 79 | 78 |
|
| 80 |
# XXX remove me |
|
| 81 |
#print "Content-type: text/html\n\n"; |
|
| 82 |
#print "skins: $skinsDir, templates: $templatesDir, tempDir: $tempDir, url: $contextUrl"; |
|
| 83 |
#exit; |
|
| 84 | 79 |
my $now = time; |
| 85 | 80 |
|
| 86 | 81 |
# Import all of the HTML form fields as variables |
| ... | ... | |
| 152 | 147 |
my @sitelist; |
| 153 | 148 |
my %siteLatDMS; |
| 154 | 149 |
my %siteLongDMS; |
| 150 |
|
|
| 155 | 151 |
while ( my ($key, $value) = each (%$spatial)) {
|
| 156 |
my ($name, $lon, $lat) = split("|", $value);
|
|
| 157 |
my ($latd, $latm, $lats, $latdir) = split('|', $lat);
|
|
| 158 |
my ($lond, $lonm, $lons, $londir) = split('|', $lon);
|
|
| 152 |
my ($name, $lon, $lat) = split(/\|/, $value);
|
|
| 153 |
my ($latd, $latm, $lats, $latdir) = split(/\|/, $lat);
|
|
| 154 |
my ($lond, $lonm, $lons, $londir) = split(/\|/, $lon);
|
|
| 159 | 155 |
push(@sitelist, $name); |
| 160 | 156 |
$siteLatDMS{$name} = [ $latd, $latm, $lats, $latdir ];
|
| 161 | 157 |
$siteLongDMS{$name} = [ $lond, $lonm, $lons, $londir ];
|
| ... | ... | |
| 178 | 174 |
#exit; |
| 179 | 175 |
# Set up the template information that is common to all forms |
| 180 | 176 |
|
| 181 |
# GENERATE ME:
|
|
| 177 |
$$templateVars{'contextUrl'} = $contextUrl;
|
|
| 182 | 178 |
$$templateVars{'styleSkinsPath'} = $styleSkinsPath;
|
| 183 | 179 |
$$templateVars{'styleCommonPath'} = $styleCommonPath;
|
| 184 | 180 |
$$templateVars{'cgiPrefix'} = $cgiPrefix;
|
| ... | ... | |
| 408 | 404 |
exit(0); |
| 409 | 405 |
} else {
|
| 410 | 406 |
|
| 411 |
if($config->{'adminIsDocOwner'} eq 'true'){
|
|
| 412 |
$response = $metacat->login($username, $password); |
|
| 413 |
if (! $response) {
|
|
| 414 |
push(@errorMessages, $metacat->getMessage()); |
|
| 415 |
push(@errorMessages, "Failed during login for admin.\n"); |
|
| 416 |
$$templateVars{'status'} = 'login_failure';
|
|
| 417 |
$$templateVars{'errorMessages'} = \@errorMessages;
|
|
| 418 |
$$templateVars{'docid'} = $docid;
|
|
| 419 |
$$templateVars{'cfg'} = $skinName;
|
|
| 420 |
$$templateVars{'function'} = "submitted";
|
|
| 421 |
$$templateVars{'section'} = "Submission Status";
|
|
| 422 |
$template->process( $templates->{'response'}, $templateVars);
|
|
| 423 |
exit(0); |
|
| 424 |
} |
|
| 425 |
} |
|
| 407 |
if($config->{'adminIsDocOwner'} eq 'true'){
|
|
| 408 |
debug("Registry: adminIsDocOwner is set.");
|
|
| 409 |
$response = $metacat->login($username, $password); |
|
| 410 |
if (! $response) {
|
|
| 411 |
push(@errorMessages, $metacat->getMessage()); |
|
| 412 |
push(@errorMessages, "Failed during login for admin.\n"); |
|
| 413 |
$$templateVars{'status'} = 'login_failure';
|
|
| 414 |
$$templateVars{'errorMessages'} = \@errorMessages;
|
|
| 415 |
$$templateVars{'docid'} = $docid;
|
|
| 416 |
$$templateVars{'cfg'} = $skinName;
|
|
| 417 |
$$templateVars{'function'} = "submitted";
|
|
| 418 |
$$templateVars{'section'} = "Submission Status";
|
|
| 419 |
$template->process( $templates->{'response'}, $templateVars);
|
|
| 420 |
exit(0); |
|
| 421 |
} |
|
| 422 |
} |
|
| 426 | 423 |
|
| 427 | 424 |
debug( "Registry: A"); |
| 428 | 425 |
if ($FORM::docid eq "") {
|
| 429 | 426 |
debug( "Registry: B1"); |
| 430 | 427 |
# document is being inserted |
| 431 |
my $notunique = "NOT_UNIQUE";
|
|
| 432 |
while ($notunique eq "NOT_UNIQUE") {
|
|
| 428 |
my $docStatus = "INCOMPLETE";
|
|
| 429 |
while ($docStatus eq "INCOMPLETE") {
|
|
| 433 | 430 |
$docid = newAccessionNumber($config->{'scope'});
|
| 434 |
|
|
| 435 |
$xmldocWithDocID = $xmldoc; |
|
| 431 |
|
|
| 436 | 432 |
$xmldocWithDocID =~ s/docid/$docid/; |
| 437 |
|
|
| 438 |
# Code for testing the xml file being inserted#### |
|
| 439 |
#my $testFile = "/tmp/test.xml"; |
|
| 440 |
#open (TFILE,">$testFile") || die ("Cant open xml file...\n");
|
|
| 441 |
#print TFILE $xmldoc; |
|
| 442 |
#close(TFILE); |
|
| 443 |
#### |
|
| 444 |
|
|
| 445 |
$notunique = insertMetadata($xmldocWithDocID, $docid); |
|
| 446 |
# if (!$notunique) {
|
|
| 447 |
# Write out the XML file for debugging purposes |
|
| 448 |
#my $testFile = $tempDir . "/test-new.xml"; |
|
| 449 |
#open (TFILE,">$testFile") || die ("Cant open xml file...\n");
|
|
| 450 |
#print TFILE $newdoc; |
|
| 451 |
#close(TFILE); |
|
| 452 |
# } |
|
| 453 |
|
|
| 454 |
# The id wasn't unique, so update our lastid file |
|
| 455 |
if ($notunique eq "NOT_UNIQUE") {
|
|
| 456 |
debug( "Registry: Updating lastid (B1.1)"); |
|
| 457 |
updateLastId($config->{'scope'});
|
|
| 458 |
} |
|
| 433 |
$docStatus = insertMetadata($xmldocWithDocID, $docid); |
|
| 459 | 434 |
} |
| 460 | 435 |
debug("Registry: B2");
|
| 461 |
if ($notunique ne "SUCCESS") {
|
|
| 436 |
if ($docStatus ne "SUCCESS") {
|
|
| 462 | 437 |
debug("Registry: NO SUCCESS");
|
| 463 |
debug("Message is: $notunique");
|
|
| 464 |
push(@errorMessages, $notunique);
|
|
| 438 |
debug("Message is: $docStatus");
|
|
| 439 |
push(@errorMessages, $docStatus);
|
|
| 465 | 440 |
} |
| 466 | 441 |
|
| 467 | 442 |
debug("Registry: B3");
|
| ... | ... | |
| 547 | 522 |
|
| 548 | 523 |
exit(0); |
| 549 | 524 |
|
| 550 |
|
|
| 551 | 525 |
################################################################################ |
| 552 | 526 |
# |
| 553 |
# Subroutine for updating a metacat id for a given scope to the highest value |
|
| 554 |
# |
|
| 555 |
################################################################################ |
|
| 556 |
sub updateLastId {
|
|
| 557 |
my $scope = shift; |
|
| 558 |
$metacat = Metacat->new($metacatUrl); |
|
| 559 |
my $errormsg = 0; |
|
| 560 |
|
|
| 561 |
my $docid = $metacat->getLastId($scope); |
|
| 562 |
|
|
| 563 |
if ($docid =~ /null/) {
|
|
| 564 |
# No docids with this scope present, so do nothing |
|
| 565 |
} elsif ($docid) {
|
|
| 566 |
# Update the lastid file for this scope |
|
| 567 |
(my $foundScope, my $id, my $rev) = split(/\./, $docid); |
|
| 568 |
debug("Docid is: $docid\n");
|
|
| 569 |
debug("Lastid is: $id");
|
|
| 570 |
my $scopeFile = $skinsDir . "/" . $skinName . "/" . $scope . ".lastid"; |
|
| 571 |
# FIXME: skins dir isn't generally writeable by the HTTP server, use tmp instead |
|
| 572 |
open(LASTID, "+>$scopeFile") or |
|
| 573 |
die "Failed to open lastid file for writing!"; |
|
| 574 |
print LASTID $id, "\n"; |
|
| 575 |
close(LASTID); |
|
| 576 |
} else {
|
|
| 577 |
$errormsg = $metacat->getMessage(); |
|
| 578 |
debug("Error in getLastId: $errormsg");
|
|
| 579 |
} |
|
| 580 |
} |
|
| 581 |
|
|
| 582 |
################################################################################ |
|
| 583 |
# |
|
| 584 | 527 |
# Subroutine for inserting a document to metacat |
| 585 | 528 |
# |
| 586 | 529 |
################################################################################ |
| ... | ... | |
| 589 | 532 |
my $docid = shift; |
| 590 | 533 |
|
| 591 | 534 |
debug("Trying to insert the following document");
|
| 592 |
my $notunique = "SUCCESS";
|
|
| 535 |
my $docStatus = "SUCCESS";
|
|
| 593 | 536 |
debug("Registry: Starting insert (D1)");
|
| 594 | 537 |
|
| 595 |
#$metacat = Metacat->new($metacatUrl); |
|
| 596 | 538 |
my $response = $metacat->insert($docid, $xmldoc); |
| 597 | 539 |
if (! $response) {
|
| 598 | 540 |
debug("Registry: Response gotten (D2)");
|
| 599 |
my $errormsg = $metacat->getMessage(); |
|
| 600 |
debug("Registry: Error is (D3): ".$errormsg);
|
|
| 541 |
my $errormsg = $metacat->getMessage();i
|
|
| 542 |
debug("Registry: Error is (D3): " . $errormsg);
|
|
| 601 | 543 |
if ($errormsg =~ /is already in use/) {
|
| 602 |
$notunique = "NOT_UNIQUE"; |
|
| 603 |
#print "Accession number already used: $docid\n"; |
|
| 544 |
$docStatus = "INCOMPLETE"; |
|
| 604 | 545 |
} elsif ($errormsg =~ /<login>/) {
|
| 605 |
$notunique = "SUCCESS"; |
|
| 606 |
} else {
|
|
| 607 |
#print "<p>Dumping error on failure...</p>\n"; |
|
| 608 |
#print "<p>", $errormsg, "</p>\n"; |
|
| 609 |
#die "Failed during insert\n"; |
|
| 610 |
#print "<p>Failed during insert</p>\n"; |
|
| 611 |
$notunique = $errormsg; |
|
| 546 |
$docStatus = "SUCCESS"; |
|
| 547 |
} else {
|
|
| 548 |
$docStatus = $errormsg; |
|
| 612 | 549 |
} |
| 613 | 550 |
} |
| 614 | 551 |
debug("Registry: Ending insert (D4)");
|
| 615 | 552 |
|
| 616 |
return $notunique;
|
|
| 553 |
return $docStatus;
|
|
| 617 | 554 |
} |
| 618 | 555 |
|
| 619 | 556 |
################################################################################ |
| ... | ... | |
| 623 | 560 |
# Also: need to check metacat for max id # used in this scope already |
| 624 | 561 |
################################################################################ |
| 625 | 562 |
sub newAccessionNumber {
|
| 626 |
my $scope = shift; |
|
| 627 |
|
|
| 628 |
my $docrev = 1; |
|
| 629 |
my $lastid = 1; |
|
| 563 |
my $scope = shift; |
|
| 564 |
my $errormsg = 0; |
|
| 630 | 565 |
|
| 631 |
my $scopeFile = $skinsDir . "/" . $skinName . "/" . $scope . ".lastid"; |
|
| 632 |
if (-e $scopeFile) {
|
|
| 633 |
open(LASTID, "<$scopeFile") or die "Failed to generate accession number!"; |
|
| 634 |
$lastid = <LASTID>; |
|
| 635 |
chomp($lastid); |
|
| 636 |
$lastid++; |
|
| 637 |
close(LASTID); |
|
| 638 |
} |
|
| 639 |
#debug("scopeFile: $scopeFile");
|
|
| 640 |
open(LASTID, ">$scopeFile") or die "Failed to open lastid file for writing!"; |
|
| 641 |
print LASTID $lastid, "\n"; |
|
| 642 |
close(LASTID); |
|
| 566 |
my $docid = $metacat->getLastId($scope); |
|
| 643 | 567 |
|
| 644 |
my $docroot = "$scope.$lastid."; |
|
| 645 |
my $docid = $docroot . $docrev; |
|
| 646 |
return $docid; |
|
| 568 |
if (!$docid) {
|
|
| 569 |
$docid = "$scope.1.1"; |
|
| 570 |
debug("Error in newAccessionNumber: " . $metacat->getMessage());
|
|
| 571 |
} else {
|
|
| 572 |
my ($foundScope, $id, $rev) = split(/\./, $docid); |
|
| 573 |
$id++; |
|
| 574 |
$docid = "$scope.$id.1"; |
|
| 575 |
} |
|
| 576 |
debug("Registry: Metcat handed us a new docid: $docid");
|
|
| 577 |
return $docid; |
|
| 647 | 578 |
} |
| 648 | 579 |
|
| 649 | 580 |
################################################################################ |
| ... | ... | |
| 1013 | 944 |
} |
| 1014 | 945 |
|
| 1015 | 946 |
my $docid = newAccessionNumber($config->{'scope'});
|
| 1016 |
my $unique = uploadData($outFile, $docid); |
|
| 1017 |
if (!$unique) {
|
|
| 1018 |
debug( "Registry: Updating lastid file"); |
|
| 1019 |
updateLastId($config->{'scope'});
|
|
| 947 |
my $uploadReturn = uploadData($outFile, $docid); |
|
| 948 |
if (!$uploadReturn) {
|
|
| 949 |
debug( "Registry: uploading the data failed."); |
|
| 1020 | 950 |
} |
| 1021 | 951 |
|
| 1022 | 952 |
my $entityid = $fileHash."001"; |
| ... | ... | |
| 1242 | 1172 |
$roleName = $defaultRole; |
| 1243 | 1173 |
} |
| 1244 | 1174 |
|
| 1245 |
#debug("XXXXX role name: " . $roleName);
|
|
| 1246 | 1175 |
push (@{$orig{$roleName}}, [$first, $last, $origRole]);
|
| 1247 | 1176 |
} |
| 1248 | 1177 |
} |
| ... | ... | |
| 2424 | 2353 |
eval($$templateVars{'latMin1'} = int($coord));
|
| 2425 | 2354 |
eval($coord = ($coord - int($coord))*60); |
| 2426 | 2355 |
eval($$templateVars{'latSec1'} = int($coord));
|
| 2427 |
|
|
| 2356 |
|
|
| 2428 | 2357 |
$coord = findValue($tempNode, "boundingCoordinates/eastBoundingCoordinate"); |
| 2429 | 2358 |
if ($coord > 0) {
|
| 2430 | 2359 |
#print "+"; |
| ... | ... | |
| 2440 | 2369 |
eval($coord = ($coord - int($coord))*60); |
| 2441 | 2370 |
eval($$templateVars{'longSec2'} = int($coord));
|
| 2442 | 2371 |
|
| 2443 |
$$templateVars{'hasSpatial'} = "true";
|
|
| 2372 |
$$templateVars{'hasSpatial'} = "true";
|
|
| 2444 | 2373 |
} |
| 2445 | 2374 |
} |
| 2446 | 2375 |
|
| ... | ... | |
| 2452 | 2381 |
my $taxonRankValue = findValue($tempNode, "taxonRankValue"); |
| 2453 | 2382 |
$$templateVars{"taxonRankName".$taxonIndex} = $taxonRankName;
|
| 2454 | 2383 |
$$templateVars{"taxonRankValue".$taxonIndex} = $taxonRankValue;
|
| 2455 |
|
|
| 2456 |
$$templateVars{'hasTaxonomic'} = "true";
|
|
| 2384 |
$$templateVars{'hasTaxonomic'} = "true";
|
|
| 2457 | 2385 |
} |
| 2458 | 2386 |
$$templateVars{'taxaCount'} = $taxonIndex;
|
| 2459 | 2387 |
my $taxaAuth = findValue($node, "./taxonomicCoverage/generalTaxonomicCoverage"); |
Also available in: Unified diff
Number of fixes, including removing all lastid code and replacing with a single function which always queries remotely instead of relying on lookups, solving #3019. Fixed parsing of spatial coordinates for site-based skins, removed dependency on AppConfig as we're fully using .properties files at this point.