Revision 8813
Added by Lauren Walker almost 10 years ago
| src/perl/register-dataset.cgi | ||
|---|---|---|
| 1 |
#!/usr/bin/env perl |
|
| 2 |
# |
|
| 3 |
# '$RCSfile$' |
|
| 4 |
# Copyright: 2000 Regents of the University of California |
|
| 5 |
# |
|
| 6 |
# '$Author$' |
|
| 7 |
# '$Date$' |
|
| 8 |
# '$Revision$' |
|
| 9 |
# |
|
| 10 |
# This program is free software; you can redistribute it and/or modify |
|
| 11 |
# it under the terms of the GNU General Public License as published by |
|
| 12 |
# the Free Software Foundation; either version 2 of the License, or |
|
| 13 |
# (at your option) any later version. |
|
| 14 |
# |
|
| 15 |
# This program is distributed in the hope that it will be useful, |
|
| 16 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
| 17 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
| 18 |
# GNU General Public License for more details. |
|
| 19 |
# |
|
| 20 |
# You should have received a copy of the GNU General Public License |
|
| 21 |
# along with this program; if not, write to the Free Software |
|
| 22 |
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
| 23 |
# |
|
| 1 |
#!/bin/sh |
|
| 24 | 2 |
|
| 3 |
# test-registry-submission.sh |
|
| 4 |
# |
|
| 25 | 5 |
# |
| 26 |
# This is a CGI application for inserting metadata documents into |
|
| 27 |
# the Metacat database. It utilizes the Metacat.pm module for most work. |
|
| 28 |
# In this script, we process the form fields passed in from a POST, insert a |
|
| 29 |
# metadata document and an ACL document. |
|
| 30 |
|
|
| 31 |
use lib '../WEB-INF/lib'; |
|
| 32 |
use Metacat; |
|
| 33 |
use Config::Properties; |
|
| 34 |
use Cwd 'abs_path'; |
|
| 35 |
use XML::LibXML; |
|
| 36 |
use XML::LibXSLT; |
|
| 37 |
use Template; |
|
| 38 |
use Net::SMTP; |
|
| 39 |
use CGI qw/:standard :html3/; |
|
| 40 |
use CGI::Session; |
|
| 41 |
use Digest::SHA1; |
|
| 42 |
use File::stat; |
|
| 43 |
use File::Basename; |
|
| 44 |
use File::Temp; |
|
| 45 |
use File::Copy; |
|
| 46 |
use Fcntl qw(:flock); |
|
| 47 |
use strict; |
|
| 48 |
|
|
| 49 |
#debug("running register-dataset.cgi");
|
|
| 50 |
|
|
| 51 |
# Global configuration paramters |
|
| 52 |
my $cgiDir = $ENV{'SCRIPT_FILENAME'};
|
|
| 53 |
my $workingDirectory = "."; |
|
| 54 |
if ( $cgiDir ne "" ) {
|
|
| 55 |
my $workingDirectory = dirname($cgiDir); |
|
| 56 |
} |
|
| 57 |
my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";
|
|
| 58 |
my $properties = new Config::Properties(); |
|
| 59 |
unless ( open( METACAT_PROPERTIES, $metacatProps ) ) {
|
|
| 60 |
print "Content-type: text/html\n\n"; |
|
| 61 |
|
|
| 62 |
"Unable to locate Metacat properties. Working directory is set as '$workingDirectory', is this correct?"; |
|
| 63 |
exit(); |
|
| 64 |
} |
|
| 65 |
|
|
| 66 |
$properties->load(*METACAT_PROPERTIES); |
|
| 67 |
|
|
| 68 |
# local directory configuration |
|
| 69 |
my $skinsDir = "${workingDirectory}/../style/skins";
|
|
| 70 |
my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");
|
|
| 71 |
my $tempDir = $properties->getProperty('application.tempDir');
|
|
| 72 |
my $dataDir = $properties->getProperty('application.datafilepath');
|
|
| 73 |
|
|
| 74 |
# url configuration |
|
| 75 |
my $server = $properties->splitToTree( qr/\./, 'server' ); |
|
| 76 |
my $protocol = 'http://'; |
|
| 77 |
if ( $properties->getProperty('server.httpPort') eq '443' ) {
|
|
| 78 |
$protocol = 'https://'; |
|
| 79 |
} |
|
| 80 |
my $contextUrl = $protocol . $properties->getProperty('server.name');
|
|
| 81 |
if ( $properties->getProperty('server.httpPort') ne '80' ) {
|
|
| 82 |
$contextUrl = |
|
| 83 |
$contextUrl . ':' . $properties->getProperty('server.httpPort');
|
|
| 84 |
} |
|
| 85 |
$contextUrl = |
|
| 86 |
$contextUrl . '/' . $properties->getProperty('application.context');
|
|
| 87 |
|
|
| 88 |
my $metacatUrl = $contextUrl . "/metacat"; |
|
| 89 |
my $cgiPrefix = |
|
| 90 |
"/" . $properties->getProperty('application.context') . "/cgi-bin";
|
|
| 91 |
my $styleSkinsPath = $contextUrl . "/style/skins"; |
|
| 92 |
my $styleCommonPath = $contextUrl . "/style/common"; |
|
| 93 |
my $userManagementUrl = $properties->getProperty('auth.userManagementUrl');
|
|
| 94 |
|
|
| 95 |
my $now = time; |
|
| 96 |
|
|
| 97 |
# Import all of the HTML form fields as variables |
|
| 98 |
import_names('FORM');
|
|
| 99 |
|
|
| 100 |
# Must have a config to use Metacat |
|
| 101 |
my $skinName = ""; |
|
| 102 |
if ( hasContent($FORM::cfg) ) {
|
|
| 103 |
$skinName = $FORM::cfg; |
|
| 104 |
} |
|
| 105 |
elsif ( hasContent( $ARGV[0] ) ) {
|
|
| 106 |
$skinName = $ARGV[0]; |
|
| 107 |
} |
|
| 108 |
else {
|
|
| 109 |
debug("No configuration set.");
|
|
| 110 |
print "Content-type: text/html\n\n"; |
|
| 111 |
'Registry Error: The registry requires a skin name to continue.'; |
|
| 112 |
exit(); |
|
| 113 |
} |
|
| 114 |
|
|
| 115 |
# Metacat isn't initialized, the registry will fail in strange ways. |
|
| 116 |
if ( !hasContent($metacatUrl) ) {
|
|
| 117 |
debug("No Metacat.");
|
|
| 118 |
print "Content-type: text/html\n\n"; |
|
| 119 |
'Registry Error: Metacat is not initialized! Make sure' |
|
| 120 |
. ' MetacatUrl is set correctly in ' |
|
| 121 |
. $skinName |
|
| 122 |
. '.properties'; |
|
| 123 |
exit(); |
|
| 124 |
} |
|
| 125 |
|
|
| 126 |
# Set up the hash for returning data to the HTML templates |
|
| 127 |
my $templateVars = { 'status' => 'success' };
|
|
| 128 |
my $error = 0; |
|
| 129 |
my @errorMessages; |
|
| 130 |
|
|
| 131 |
my $skinProperties = new Config::Properties(); |
|
| 132 |
if ( !hasContent($skinName) ) {
|
|
| 133 |
$error = "Application misconfigured. Please contact the administrator."; |
|
| 134 |
push( @errorMessages, $error ); |
|
| 135 |
} |
|
| 136 |
else {
|
|
| 137 |
my $skinProps = "$skinsDir/$skinName/$skinName.properties"; |
|
| 138 |
unless ( open( SKIN_PROPERTIES, $skinProps ) ) {
|
|
| 139 |
print "Content-type: text/html\n\n"; |
|
| 140 |
print "Unable to locate skin properties at $skinProps. Is this path correct?"; |
|
| 141 |
exit(); |
|
| 142 |
} |
|
| 143 |
$skinProperties->load(*SKIN_PROPERTIES); |
|
| 144 |
} |
|
| 145 |
|
|
| 146 |
# replacements for appconfig values using properties |
|
| 147 |
my $moderators = $properties->getProperty('auth.moderators');
|
|
| 148 |
my $config = $skinProperties->splitToTree( qr/\./, 'registry.config' ); |
|
| 149 |
my $templates = $skinProperties->splitToTree( qr/\./, 'registry.templates' ); |
|
| 150 |
my $modules = $skinProperties->splitToTree( qr/\./, 'registry.modules' ); |
|
| 151 |
my $required = $skinProperties->splitToTree( qr/\./, 'registry.required' ); |
|
| 152 |
my $spatial = $skinProperties->splitToTree( qr/\./, 'registry.spatial' ); |
|
| 153 |
my $show = $skinProperties->splitToTree( qr/\./, 'registry.show' ); |
|
| 154 |
|
|
| 155 |
# set stderr printing if configured |
|
| 156 |
my $debug_enabled = $config->{'debug'};
|
|
| 157 |
if ($FORM::debug) {
|
|
| 158 |
$debug_enabled = $FORM::debug; |
|
| 159 |
} |
|
| 160 |
|
|
| 161 |
# skin owner credentials |
|
| 162 |
my $adminUsername = $config->{'username'};
|
|
| 163 |
my $adminPassword = $config->{'password'};
|
|
| 164 |
|
|
| 165 |
# contains sender, recipient, admin, mailhost |
|
| 166 |
my $skinEmail = $skinProperties->splitToTree( qr/\./, 'email' ); |
|
| 167 |
my $email = $properties->splitToTree( qr/\./, 'email' ); |
|
| 168 |
|
|
| 169 |
# override email properties with skin-based ones |
|
| 170 |
my @emailData = keys(%$email); |
|
| 171 |
foreach my $d (@emailData) {
|
|
| 172 |
if ( %$skinEmail->{$d} ) {
|
|
| 173 |
$email->{$d} = %$skinEmail->{$d};
|
|
| 174 |
} |
|
| 175 |
} |
|
| 176 |
|
|
| 177 |
# convert the lat and lon configs into usable data structures |
|
| 178 |
my @sitelist; |
|
| 179 |
my %siteLatDMS; |
|
| 180 |
my %siteLongDMS; |
|
| 181 |
|
|
| 182 |
while ( my ( $key, $value ) = each(%$spatial) ) {
|
|
| 183 |
my ( $name, $lon, $lat ) = split( /\|/, $value ); |
|
| 184 |
my ( $latd, $latm, $lats, $latdir ) = split( /\|/, $lat ); |
|
| 185 |
my ( $lond, $lonm, $lons, $londir ) = split( /\|/, $lon ); |
|
| 186 |
push( @sitelist, $name ); |
|
| 187 |
$siteLatDMS{$name} = [ $latd, $latm, $lats, $latdir ];
|
|
| 188 |
$siteLongDMS{$name} = [ $lond, $lonm, $lons, $londir ];
|
|
| 189 |
} |
|
| 190 |
|
|
| 191 |
# set some configuration options for the template object |
|
| 192 |
my $ttConfig = {
|
|
| 193 |
INCLUDE_PATH => $templatesDir, |
|
| 194 |
INTERPOLATE => 0, |
|
| 195 |
POST_CHOMP => 1, |
|
| 196 |
DEBUG => 1, |
|
| 197 |
}; |
|
| 198 |
|
|
| 199 |
# create an instance of the template processor |
|
| 200 |
my $template = Template->new($ttConfig) || die $Template::ERROR, "\n"; |
|
| 201 |
|
|
| 202 |
#print "Content-type: text/html\n\n"; |
|
| 203 |
#print "Is debug enabled? `$debug_enabled`"; |
|
| 204 |
#use Data::Dumper; |
|
| 205 |
#print Dumper($config); |
|
| 206 |
#exit; |
|
| 207 |
# Set up the template information that is common to all forms |
|
| 208 |
|
|
| 209 |
$$templateVars{'contextUrl'} = $contextUrl;
|
|
| 210 |
$$templateVars{'styleSkinsPath'} = $styleSkinsPath;
|
|
| 211 |
$$templateVars{'styleCommonPath'} = $styleCommonPath;
|
|
| 212 |
$$templateVars{'cgiPrefix'} = $cgiPrefix;
|
|
| 213 |
$$templateVars{'metacatUrl'} = $metacatUrl;
|
|
| 214 |
$$templateVars{'cfg'} = $skinName;
|
|
| 215 |
$$templateVars{'email'} = $email;
|
|
| 216 |
$$templateVars{'templates'} = $templates;
|
|
| 217 |
$$templateVars{'required'} = $required;
|
|
| 218 |
$$templateVars{'config'} = $config;
|
|
| 219 |
$$templateVars{'userManagementUrl'} = $userManagementUrl;
|
|
| 220 |
|
|
| 221 |
debug("Initialized -- stage set: $FORM::stage");
|
|
| 222 |
|
|
| 223 |
# handle pids, set the mapped docid in the FORM params |
|
| 224 |
# see: https://projects.ecoinformatics.org/ecoinfo/issues/5932 |
|
| 225 |
debug("PID: $FORM::pid");
|
|
| 226 |
if ($FORM::pid ne "" ) {
|
|
| 227 |
my $pid = $FORM::pid; |
|
| 228 |
my $metacat = Metacat->new($metacatUrl); |
|
| 229 |
my $docid = $metacat->getDocid($pid); |
|
| 230 |
$FORM::docid = $docid; |
|
| 231 |
} |
|
| 232 |
|
|
| 233 |
# Process the form based on stage parameter. |
|
| 234 |
if ( $FORM::stage =~ "loginform" ) {
|
|
| 235 |
print "Content-type: text/html\n\n"; |
|
| 236 |
|
|
| 237 |
# Send back the login form..... |
|
| 238 |
my $session = CGI::Session->load() or die CGI::Session->errstr(); |
|
| 239 |
|
|
| 240 |
if ( $FORM::submission eq 'true' ) {
|
|
| 241 |
$$templateVars{'message'} = 'You must login to view your submissions.';
|
|
| 242 |
} |
|
| 243 |
|
|
| 244 |
if ( !$session->is_empty ) {
|
|
| 245 |
|
|
| 246 |
# session found ... delete the session.... |
|
| 247 |
$session->delete(); |
|
| 248 |
} |
|
| 249 |
|
|
| 250 |
$template->process( $templates->{'login'}, $templateVars );
|
|
| 251 |
exit(); |
|
| 252 |
} |
|
| 253 |
elsif ( $FORM::stage =~ "logout" ) {
|
|
| 254 |
handleLogoutRequest(); |
|
| 255 |
exit(); |
|
| 256 |
} |
|
| 257 |
elsif ( $FORM::stage =~ "login" ) {
|
|
| 258 |
handleLoginRequest(); |
|
| 259 |
exit(); |
|
| 260 |
} |
|
| 261 |
elsif ( $FORM::stage =~ "mod_accept" ) {
|
|
| 262 |
handleModAccept(); |
|
| 263 |
exit(); |
|
| 264 |
} |
|
| 265 |
elsif ( $FORM::stage =~ "mod_decline" ) {
|
|
| 266 |
handleModDecline(); |
|
| 267 |
exit(); |
|
| 268 |
} |
|
| 269 |
elsif ( $FORM::stage =~ "mod_revise" ) {
|
|
| 270 |
handleModRevise(); |
|
| 271 |
exit(); |
|
| 272 |
} |
|
| 273 |
elsif ( $FORM::stage =~ "read" ) {
|
|
| 274 |
handleRead(); |
|
| 275 |
exit(); |
|
| 276 |
} |
|
| 277 |
elsif ( $FORM::stage =~ "review_frame" ) {
|
|
| 278 |
handleReviewFrame(); |
|
| 279 |
exit(); |
|
| 280 |
} |
|
| 281 |
|
|
| 282 |
print "Content-type: text/html\n\n"; |
|
| 283 |
|
|
| 284 |
if ( $FORM::stage =~ "guide" ) {
|
|
| 285 |
|
|
| 286 |
# Send back the information on how to fill the form |
|
| 287 |
$$templateVars{'section'} = "Guide on How to Complete Registry Entries";
|
|
| 288 |
$template->process( $templates->{'guide'}, $templateVars );
|
|
| 289 |
exit(); |
|
| 290 |
|
|
| 291 |
} |
|
| 292 |
elsif ( $FORM::stage =~ "insert" ) {
|
|
| 293 |
|
|
| 294 |
# The user has entered the data. Do data validation and send back data |
|
| 295 |
# to confirm the data that has been entered. |
|
| 296 |
toConfirmData(); |
|
| 297 |
exit(); |
|
| 298 |
|
|
| 299 |
} |
|
| 300 |
elsif ($FORM::dataWrong =~ "No, go back to editing" |
|
| 301 |
&& $FORM::stage =~ "confirmed" ) |
|
| 302 |
{
|
|
| 303 |
|
|
| 304 |
# The user wants to correct the data that he has entered. |
|
| 305 |
# Hence show the data again in entryData form. |
|
| 306 |
confirmDataToReEntryData(); |
|
| 307 |
exit(); |
|
| 308 |
|
|
| 309 |
} |
|
| 310 |
elsif ( $FORM::stage =~ "modify" ) {
|
|
| 311 |
#debug("in modify stage");
|
|
| 312 |
# Modification of a file has been requested. |
|
| 313 |
# check if the user is logged in... |
|
| 314 |
my $session = CGI::Session->load() or die CGI::Session->errstr(); |
|
| 315 |
if ( $session->is_empty ) {
|
|
| 316 |
|
|
| 317 |
# no session found ... redirect to login page template |
|
| 318 |
$$templateVars{'message'} = 'You must login to modify your dataset.';
|
|
| 319 |
$template->process( $templates->{'login'}, $templateVars );
|
|
| 320 |
} |
|
| 321 |
else {
|
|
| 322 |
|
|
| 323 |
# Show the form will all the values filled in. |
|
| 324 |
my @sortedSites; |
|
| 325 |
foreach my $site ( sort @sitelist ) {
|
|
| 326 |
push( @sortedSites, $site ); |
|
| 327 |
} |
|
| 328 |
$$templateVars{'siteList'} = \@sortedSites;
|
|
| 329 |
$$templateVars{'section'} = "Modification Form";
|
|
| 330 |
my ( $foundScope, $id, $rev ) = split( /\./, $FORM::docid ); |
|
| 331 |
if ( !$rev ) {
|
|
| 332 |
my $metacat = Metacat->new($metacatUrl); |
|
| 333 |
my $lastRev = $metacat->getLastRevision($FORM::docid); |
|
| 334 |
$$templateVars{'docid'} = $FORM::docid . "." . $lastRev;
|
|
| 335 |
} |
|
| 336 |
else {
|
|
| 337 |
$$templateVars{'docid'} = $FORM::docid;
|
|
| 338 |
} |
|
| 339 |
modifyData(); |
|
| 340 |
} |
|
| 341 |
exit(); |
|
| 342 |
|
|
| 343 |
} |
|
| 344 |
elsif ( $FORM::stage =~ "delete_confirm" ) {
|
|
| 345 |
|
|
| 346 |
# Result from deleteData form. |
|
| 347 |
if ( $FORM::deleteData =~ "Delete document" ) {
|
|
| 348 |
|
|
| 349 |
# delete Data |
|
| 350 |
deleteData(1); |
|
| 351 |
exit(); |
|
| 352 |
} |
|
| 353 |
else {
|
|
| 354 |
$$templateVars{'status'} = "Cancel";
|
|
| 355 |
$$templateVars{'function'} = "cancel";
|
|
| 356 |
$template->process( $templates->{'response'}, $templateVars );
|
|
| 357 |
exit(); |
|
| 358 |
} |
|
| 359 |
|
|
| 360 |
} |
|
| 361 |
elsif ( $FORM::stage =~ "delete" ) {
|
|
| 362 |
|
|
| 363 |
# Deletion of a file has been requested. |
|
| 364 |
# Ask for username and password using deleteDataForm |
|
| 365 |
$$templateVars{'docid'} = $FORM::docid;
|
|
| 366 |
$template->process( $templates->{'deleteData'}, $templateVars );
|
|
| 367 |
exit(); |
|
| 368 |
|
|
| 369 |
} |
|
| 370 |
elsif ( $FORM::stage !~ "confirmed" ) {
|
|
| 371 |
|
|
| 372 |
# None of the stages have been reached and data is not being confirmed. |
|
| 373 |
|
|
| 374 |
# check if the user is logged in... |
|
| 375 |
my $session = CGI::Session->load() or die CGI::Session->errstr(); |
|
| 376 |
if ( $session->is_empty ) {
|
|
| 377 |
|
|
| 378 |
# no session found ... redirect to login page template |
|
| 379 |
$$templateVars{'showInstructions'} = 'true';
|
|
| 380 |
$$templateVars{'message'} = 'You must login to register your dataset.';
|
|
| 381 |
$template->process( $templates->{'login'}, $templateVars );
|
|
| 382 |
} |
|
| 383 |
else {
|
|
| 384 |
|
|
| 385 |
# Hence, send back entry form for entry of data. |
|
| 386 |
debug("Sending form");
|
|
| 387 |
my @sortedSites; |
|
| 388 |
foreach my $site ( sort @sitelist ) {
|
|
| 389 |
push( @sortedSites, $site ); |
|
| 390 |
} |
|
| 391 |
|
|
| 392 |
if ( $skinName eq 'nceas' ) {
|
|
| 393 |
my $projects = getProjectList($properties); |
|
| 394 |
$$templateVars{'projects'} = $projects;
|
|
| 395 |
$$templateVars{'wg'} = \@FORM::wg;
|
|
| 396 |
} |
|
| 397 |
|
|
| 398 |
$$templateVars{'modules'} = $modules;
|
|
| 399 |
$$templateVars{'required'} = $required;
|
|
| 400 |
$$templateVars{'templates'} = $templates;
|
|
| 401 |
$$templateVars{'show'} = $show;
|
|
| 402 |
$$templateVars{'site'} = $config->{'site'};
|
|
| 403 |
|
|
| 404 |
$$templateVars{'siteList'} = \@sortedSites;
|
|
| 405 |
$$templateVars{'section'} = "Entry Form";
|
|
| 406 |
$$templateVars{'docid'} = "";
|
|
| 407 |
debug("Sending form: ready to process template");
|
|
| 408 |
$template->process( $templates->{'entry'}, $templateVars );
|
|
| 409 |
debug("Sending form: template processed");
|
|
| 410 |
} |
|
| 411 |
exit(); |
|
| 412 |
} |
|
| 413 |
|
|
| 414 |
# Confirm stage has been reached. Enter the data into metacat. |
|
| 415 |
|
|
| 416 |
# Initialize some global vars |
|
| 417 |
my $latDeg1 = ""; |
|
| 418 |
my $latMin1 = ""; |
|
| 419 |
my $latSec1 = ""; |
|
| 420 |
my $hemisphLat1 = ""; |
|
| 421 |
my $longDeg1 = ""; |
|
| 422 |
my $longMin1 = ""; |
|
| 423 |
my $longSec1 = ""; |
|
| 424 |
my $hemisphLong1 = ""; |
|
| 425 |
my $latDeg2 = ""; |
|
| 426 |
my $latMin2 = ""; |
|
| 427 |
my $latSec2 = ""; |
|
| 428 |
my $hemisphLat2 = ""; |
|
| 429 |
my $longDeg2 = ""; |
|
| 430 |
my $longMin2 = ""; |
|
| 431 |
my $longSec2 = ""; |
|
| 432 |
my $hemisphLong2 = ""; |
|
| 433 |
my $modUsername = ""; |
|
| 434 |
my $modPassword = ""; |
|
| 435 |
|
|
| 436 |
# validate the input form parameters |
|
| 437 |
my $invalidParams; |
|
| 438 |
|
|
| 439 |
if ( !$error ) {
|
|
| 440 |
$invalidParams = validateParameters(1); |
|
| 441 |
if ( scalar(@$invalidParams) ) {
|
|
| 442 |
$$templateVars{'status'} = 'failure';
|
|
| 443 |
$$templateVars{'invalidParams'} = $invalidParams;
|
|
| 444 |
$error = 1; |
|
| 445 |
} |
|
| 446 |
} |
|
| 447 |
|
|
| 448 |
my $docid; |
|
| 449 |
|
|
| 450 |
# Create a metacat object |
|
| 451 |
my $metacat = Metacat->new($metacatUrl); |
|
| 452 |
|
|
| 453 |
if ( !$error ) {
|
|
| 454 |
|
|
| 455 |
# Login to metacat |
|
| 456 |
my ( $username, $password ) = getCredentials(); |
|
| 457 |
my $response = $metacat->login( $username, $password ); |
|
| 458 |
my $errorMessage = ""; |
|
| 459 |
|
|
| 460 |
# Parameters have been validated and Create the XML document |
|
| 461 |
my $xmldoc = createXMLDocument(); |
|
| 462 |
|
|
| 463 |
my $xmldocWithDocID = $xmldoc; |
|
| 464 |
my $errorMessage = ""; |
|
| 465 |
|
|
| 466 |
if ( !$response ) {
|
|
| 467 |
debug("No response from Metacat");
|
|
| 468 |
push( @errorMessages, $metacat->getMessage() ); |
|
| 469 |
push( @errorMessages, "Failed during login.\n" ); |
|
| 470 |
$$templateVars{'status'} = 'login_failure';
|
|
| 471 |
$$templateVars{'errorMessages'} = \@errorMessages;
|
|
| 472 |
$$templateVars{'docid'} = $docid;
|
|
| 473 |
$$templateVars{'cfg'} = $skinName;
|
|
| 474 |
$$templateVars{'function'} = "submitted";
|
|
| 475 |
$$templateVars{'section'} = "Submission Status";
|
|
| 476 |
$template->process( $templates->{'response'}, $templateVars );
|
|
| 477 |
exit(); |
|
| 478 |
} |
|
| 479 |
else {
|
|
| 480 |
|
|
| 481 |
if ( $config->{'adminIsDocOwner'} eq 'true' ) {
|
|
| 482 |
debug("adminIsDocOwner is set.");
|
|
| 483 |
$response = $metacat->login( $adminUsername, $adminPassword ); |
|
| 484 |
if ( !$response ) {
|
|
| 485 |
push( @errorMessages, $metacat->getMessage() ); |
|
| 486 |
push( @errorMessages, "Failed during login for admin.\n" ); |
|
| 487 |
$$templateVars{'status'} = 'login_failure';
|
|
| 488 |
$$templateVars{'errorMessages'} = \@errorMessages;
|
|
| 489 |
$$templateVars{'docid'} = $docid;
|
|
| 490 |
$$templateVars{'cfg'} = $skinName;
|
|
| 491 |
$$templateVars{'function'} = "submitted";
|
|
| 492 |
$$templateVars{'section'} = "Submission Status";
|
|
| 493 |
$template->process( $templates->{'response'}, $templateVars );
|
|
| 494 |
exit(); |
|
| 495 |
} |
|
| 496 |
} |
|
| 497 |
|
|
| 498 |
debug("A");
|
|
| 499 |
if ( $FORM::docid eq "" ) {
|
|
| 500 |
debug("B1");
|
|
| 501 |
|
|
| 502 |
# document is being inserted |
|
| 503 |
my $docStatus = "INCOMPLETE"; |
|
| 504 |
|
|
| 505 |
#Lock a local file while we are creating a new docid |
|
| 506 |
my $lockFilePath = "docids.lock"; |
|
| 507 |
open my $lock, '>', $lockFilePath; |
|
| 508 |
flock($lock, LOCK_EX); |
|
| 509 |
|
|
| 510 |
my $logFilePath = "log.txt"; |
|
| 511 |
open my $log, '>>', $logFilePath; |
|
| 512 |
print $log "\n----next doc---\n"; |
|
| 513 |
|
|
| 514 |
my $tries = 0; |
|
| 515 |
my $configScope = $config->{'scope'};
|
|
| 516 |
|
|
| 517 |
while ($docStatus eq "INCOMPLETE") {
|
|
| 518 |
|
|
| 519 |
my $docidsFilePath = "docids.txt"; |
|
| 520 |
my $docidsFilePathNew = "docids.txt.new"; |
|
| 521 |
|
|
| 522 |
#Open/create a local file while we are creating a new docid |
|
| 523 |
open my $docidsFile, '+<', $docidsFilePath; |
|
| 524 |
open my $docidsNewFile, '>', $docidsFilePathNew; |
|
| 525 |
|
|
| 526 |
#Read each docid scope,num in the file |
|
| 527 |
while( <$docidsFile> ) {
|
|
| 528 |
my @line = split /,/; |
|
| 529 |
my $scope = $line[0]; |
|
| 530 |
|
|
| 531 |
if($scope eq $configScope){
|
|
| 532 |
|
|
| 533 |
my $newDocId = $line[1] + 1; |
|
| 534 |
$docid = "$configScope.$newDocId.1"; |
|
| 535 |
|
|
| 536 |
print $docidsNewFile "$configScope,$newDocId \n"; |
|
| 537 |
|
|
| 538 |
} |
|
| 539 |
else{
|
|
| 540 |
print $docidsNewFile $_; |
|
| 541 |
} |
|
| 542 |
} |
|
| 543 |
|
|
| 544 |
#Close the file and replace the old docids file with this new one |
|
| 545 |
close $docidsNewFile; |
|
| 546 |
close $docidsFile; |
|
| 547 |
move($docidsFilePathNew, $docidsFilePath); |
|
| 548 |
|
|
| 549 |
if((!$docid) || ($tries > 5)){
|
|
| 550 |
print $log "We DID NOT create a docid from the local file\n"; |
|
| 551 |
|
|
| 552 |
#Create the docid |
|
| 553 |
#$docid = newAccessionNumber( $config->{'scope'}, $metacat );
|
|
| 554 |
$docid = newAccessionNumber( "walker", $metacat ); |
|
| 555 |
|
|
| 556 |
print $log "newAccessionNum: $docid\n"; |
|
| 557 |
|
|
| 558 |
$xmldocWithDocID =~ s/docid/$docid/; |
|
| 559 |
debugDoc($xmldocWithDocID); |
|
| 560 |
$docStatus = insertMetadata( $xmldocWithDocID, $docid ); |
|
| 561 |
print $log "docStatus: $docStatus\n------------\n"; |
|
| 562 |
|
|
| 563 |
#Append the new docid |
|
| 564 |
#my @line = split(/\./, $docid); |
|
| 565 |
#my $scope = $line[0]; |
|
| 566 |
#my $num = $line[1]; |
|
| 567 |
|
|
| 568 |
#open my $docidsFile, '>>', $docidsFilePath; |
|
| 569 |
|
|
| 570 |
#print $docidsFile "$scope,$num\n"; |
|
| 571 |
|
|
| 572 |
#close $docidsFile; |
|
| 573 |
} |
|
| 574 |
else{
|
|
| 575 |
print $log "We created a docid: $docid\n"; |
|
| 576 |
$xmldocWithDocID =~ s/docid/$docid/; |
|
| 577 |
|
|
| 578 |
debugDoc($xmldocWithDocID); |
|
| 579 |
|
|
| 580 |
$docStatus = insertMetadata( $xmldocWithDocID, $docid ); |
|
| 581 |
print $log "docStatus: $docStatus\n------------\n"; |
|
| 582 |
|
|
| 583 |
$tries++; |
|
| 584 |
} |
|
| 585 |
|
|
| 586 |
debug("B2");
|
|
| 587 |
} |
|
| 588 |
|
|
| 589 |
close $log; |
|
| 590 |
close $lock; |
|
| 591 |
|
|
| 592 |
if ( $docStatus ne "SUCCESS" ) {
|
|
| 593 |
debug("NO SUCCESS");
|
|
| 594 |
debug("Message is: $docStatus");
|
|
| 595 |
|
|
| 596 |
push( @errorMessages, $docStatus ); |
|
| 597 |
} |
|
| 598 |
else{
|
|
| 599 |
deleteRemovedData(); |
|
| 600 |
} |
|
| 601 |
|
|
| 602 |
debug("B3");
|
|
| 603 |
} |
|
| 604 |
else {
|
|
| 605 |
debug("M1");
|
|
| 606 |
|
|
| 607 |
# document is being modified |
|
| 608 |
$docid = incrementRevision($FORM::docid); |
|
| 609 |
|
|
| 610 |
$xmldoc =~ s/docid/$docid/; |
|
| 611 |
debugDoc($xmldoc); |
|
| 612 |
|
|
| 613 |
my $response = $metacat->update( $docid, $xmldoc ); |
|
| 614 |
|
|
| 615 |
if ( !$response ) {
|
|
| 616 |
push( @errorMessages, $metacat->getMessage() ); |
|
| 617 |
push( @errorMessages, "Failed while updating.\n" ); |
|
| 618 |
} |
|
| 619 |
|
|
| 620 |
debug("M2, $docid");
|
|
| 621 |
if ( scalar(@errorMessages) ) {
|
|
| 622 |
debug("Errors defined in modify.");
|
|
| 623 |
|
|
| 624 |
$$templateVars{'docid'} = $FORM::docid;
|
|
| 625 |
copyFormToTemplateVars(); |
|
| 626 |
$$templateVars{'status'} = 'failure';
|
|
| 627 |
$$templateVars{'errorMessages'} = \@errorMessages;
|
|
| 628 |
$error = 1; |
|
| 629 |
} |
|
| 630 |
else {
|
|
| 631 |
deleteRemovedData(); |
|
| 632 |
$$templateVars{'docid'} = $docid;
|
|
| 633 |
$$templateVars{'cfg'} = $skinName;
|
|
| 634 |
} |
|
| 635 |
|
|
| 636 |
# Create our HTML response and send it back |
|
| 637 |
$$templateVars{'function'} = "modified";
|
|
| 638 |
$$templateVars{'section'} = "Modification Status";
|
|
| 639 |
$template->process( $templates->{'response'}, $templateVars );
|
|
| 640 |
|
|
| 641 |
# send a notification email to the moderator |
|
| 642 |
if ( hasContent($FORM::cfg) && $FORM::cfg eq 'esa' ) {
|
|
| 643 |
my $title = ""; |
|
| 644 |
my $contactEmailAddress = ""; |
|
| 645 |
my $contactName = ""; |
|
| 646 |
my $parser = XML::LibXML->new(); |
|
| 647 |
my $parsedDoc = $parser->parse_string($xmldoc); |
|
| 648 |
$FORM::function = 'modified'; |
|
| 649 |
|
|
| 650 |
my $findNodes = $parsedDoc->findnodes('//dataset/title');
|
|
| 651 |
if ( $findNodes->size() > 0 ) {
|
|
| 652 |
|
|
| 653 |
# found title |
|
| 654 |
my $node = ''; |
|
| 655 |
foreach $node ( $findNodes->get_nodelist ) {
|
|
| 656 |
$title = findValue( $node, '../title' ); |
|
| 657 |
} |
|
| 658 |
} |
|
| 659 |
|
|
| 660 |
$findNodes = $parsedDoc->findnodes('//dataset/contact');
|
|
| 661 |
if ( $findNodes->size() > 0 ) {
|
|
| 662 |
|
|
| 663 |
# found contact email address |
|
| 664 |
my $node = ''; |
|
| 665 |
foreach $node ( $findNodes->get_nodelist ) {
|
|
| 666 |
my $surName = |
|
| 667 |
findValue( $node, 'individualName/surName' ); |
|
| 668 |
my $givenName = |
|
| 669 |
findValue( $node, 'individualName/givenName' ); |
|
| 670 |
my $organizationName = |
|
| 671 |
findValue( $node, 'organizationName' ); |
|
| 672 |
|
|
| 673 |
if ( $surName ne '' ) {
|
|
| 674 |
$contactName = $givenName . ' ' . $surName; |
|
| 675 |
} |
|
| 676 |
else {
|
|
| 677 |
$contactName = $organizationName; |
|
| 678 |
} |
|
| 679 |
} |
|
| 680 |
} |
|
| 681 |
|
|
| 682 |
$FORM::docid = $docid; |
|
| 683 |
|
|
| 684 |
modSendNotification( $title, $contactEmailAddress, $contactName, |
|
| 685 |
"Document $docid modification review pending" ); |
|
| 686 |
} |
|
| 687 |
exit(); |
|
| 688 |
} |
|
| 689 |
} |
|
| 690 |
|
|
| 691 |
if ( hasContent($FORM::cfg) && $FORM::cfg eq 'esa' ) {
|
|
| 692 |
my $title = ""; |
|
| 693 |
my $contactEmailAddress = ""; |
|
| 694 |
my $contactName = ""; |
|
| 695 |
my $parser = XML::LibXML->new(); |
|
| 696 |
my $parsedDoc = $parser->parse_string($xmldoc); |
|
| 697 |
|
|
| 698 |
my $findNodes = $parsedDoc->findnodes('//dataset/title');
|
|
| 699 |
if ( $findNodes->size() > 0 ) {
|
|
| 700 |
|
|
| 701 |
# found title |
|
| 702 |
my $node = ''; |
|
| 703 |
foreach $node ( $findNodes->get_nodelist ) {
|
|
| 704 |
$title = findValue( $node, '../title' ); |
|
| 705 |
} |
|
| 706 |
} |
|
| 707 |
|
|
| 708 |
$findNodes = $parsedDoc->findnodes('//dataset/contact');
|
|
| 709 |
if ( $findNodes->size() > 0 ) {
|
|
| 710 |
|
|
| 711 |
# found contact email address |
|
| 712 |
my $node = ''; |
|
| 713 |
foreach $node ( $findNodes->get_nodelist ) {
|
|
| 714 |
$contactEmailAddress = findValue( $node, 'electronicMailAddress' ); |
|
| 715 |
my $surName = findValue( $node, 'individualName/surName' ); |
|
| 716 |
my $givenName = findValue( $node, 'individualName/givenName' ); |
|
| 717 |
my $organizationName = findValue( $node, 'organizationName' ); |
|
| 718 |
|
|
| 719 |
if ( $surName ne '' ) {
|
|
| 720 |
$contactName = $givenName . ' ' . $surName; |
|
| 721 |
} |
|
| 722 |
else {
|
|
| 723 |
$contactName = $organizationName; |
|
| 724 |
} |
|
| 725 |
} |
|
| 726 |
} |
|
| 727 |
$FORM::docid = $docid; |
|
| 728 |
|
|
| 729 |
modSendNotification( $title, $contactEmailAddress, $contactName, |
|
| 730 |
"Document $docid review pending" ); |
|
| 731 |
} |
|
| 732 |
} |
|
| 733 |
|
|
| 734 |
debug("C");
|
|
| 735 |
|
|
| 736 |
if ( scalar(@errorMessages) ) {
|
|
| 737 |
debug("ErrorMessages defined.");
|
|
| 738 |
$$templateVars{'docid'} = $FORM::docid;
|
|
| 739 |
copyFormToTemplateVars(); |
|
| 740 |
$$templateVars{'status'} = 'failure';
|
|
| 741 |
$$templateVars{'errorMessages'} = \@errorMessages;
|
|
| 742 |
$error = 1; |
|
| 743 |
} |
|
| 744 |
else {
|
|
| 745 |
$$templateVars{'docid'} = $docid;
|
|
| 746 |
$$templateVars{'cfg'} = $skinName;
|
|
| 747 |
|
|
| 748 |
# delete the remaining file objects from disk |
|
| 749 |
for ( my $fileNum = 0 ; $fileNum <= $FORM::upCount ; $fileNum++ ) {
|
|
| 750 |
my $fn = 'uploadname_' . $fileNum; |
|
| 751 |
if ( hasContent( param($fn) ) ) {
|
|
| 752 |
deleteFile( param($fn) ); |
|
| 753 |
} |
|
| 754 |
} |
|
| 755 |
|
|
| 756 |
} |
|
| 757 |
|
|
| 758 |
# Create our HTML response and send it back |
|
| 759 |
$$templateVars{'function'} = "submitted";
|
|
| 760 |
$$templateVars{'section'} = "Submission Status";
|
|
| 761 |
|
|
| 762 |
$template->process( $templates->{'response'}, $templateVars );
|
|
| 763 |
|
|
| 764 |
exit(); |
|
| 765 |
|
|
| 766 |
################################################################################ |
|
| 6 |
# Created by Lauren Walker on 7/23/14. |
|
| 767 | 7 |
# |
| 768 |
# Subroutine for inserting a document to metacat |
|
| 769 |
# |
|
| 770 |
################################################################################ |
|
| 771 |
sub insertMetadata {
|
|
| 772 |
my $xmldoc = shift; |
|
| 773 |
my $docid = shift; |
|
| 774 | 8 |
|
| 775 |
debug("Trying to insert the following document");
|
|
| 776 |
my $docStatus = "SUCCESS"; |
|
| 777 |
debug("Starting insert of $docid (D1)");
|
|
| 9 |
> fileDetails.txt |
|
| 10 |
> results.html |
|
| 778 | 11 |
|
| 779 |
my $response = $metacat->insert( $docid, $xmldoc ); |
|
| 780 |
if ( !$response ) {
|
|
| 781 |
debug("Response gotten (D2)");
|
|
| 782 |
my $errormsg = $metacat->getMessage(); |
|
| 783 |
debug( "Error is (D3): " . $errormsg ); |
|
| 784 |
if ( $errormsg =~ /is already in use/ ) {
|
|
| 785 |
$docStatus = "INCOMPLETE"; |
|
| 786 |
} |
|
| 787 |
elsif ( $errormsg =~ /<login>/ ) {
|
|
| 788 |
$docStatus = "SUCCESS"; |
|
| 789 |
} |
|
| 790 |
else {
|
|
| 791 |
$docStatus = $errormsg; |
|
| 792 |
} |
|
| 793 |
} |
|
| 794 |
debug("Ending insert (D4)");
|
|
| 12 |
counter="0" |
|
| 795 | 13 |
|
| 796 |
return $docStatus; |
|
| 797 |
} |
|
| 14 |
while [ $counter -lt 3 ] |
|
| 15 |
do |
|
| 16 |
response=$(curl -X POST --cookie "JSESSIONID=81E77F52A2CA1D632B6CF01925D54FE0;SESS6790668dc29fdba8b64e6f4c1193c83d=yRZg3Ap9kK1TJGef_oOsPu4nMUe_SMEB8ICQrpsuOHI;CGISESSID=5c43858469558146ec0439e5b20500fd" --form file_0=@testdata.csv --form cfg=metacatui --form stage=insert --form providerGivenName=Lauren --form providerSurName=Walker --form "title=test with curl $counter" --form site=NCEAS --form origNamefirst0=walker --form origNamelast0=Walker --form abstract=abstract --form beginningYear=2014 --form geogdesc=Cali --form latDeg1=0 --form longDeg1=0 --form dataMedium=digital --form "useConstraints=no restrictions" --form useOrigAddress=on --form fileCount=1 --form justGetUploadDetails=true "https://dev.nceas.ucsb.edu/knb/cgi-bin/register-dataset.cgi") |
|
| 798 | 17 |
|
| 799 |
################################################################################ |
|
| 800 |
# |
|
| 801 |
# Subroutine for generating a new accession number |
|
| 802 |
# Note: this is not threadsafe, assumes only one running process at a time |
|
| 803 |
# Also: need to check metacat for max id # used in this scope already |
|
| 804 |
################################################################################ |
|
| 805 |
sub newAccessionNumber {
|
|
| 806 |
my $scope = shift; |
|
| 807 |
my $metacat = shift; |
|
| 808 |
my $errormsg = 0; |
|
| 18 |
echo $response >> fileDetails.txt |
|
| 19 |
counter=$[$counter+1] |
|
| 20 |
done |
|
| 809 | 21 |
|
| 810 |
my $docid = $metacat->getLastId($scope); |
|
| 811 |
if ( !$docid ) {
|
|
| 812 |
$docid = "$scope.1.1"; |
|
| 813 |
debug( "Error in newAccessionNumber: " . $metacat->getMessage() ); |
|
| 814 |
} |
|
| 815 |
else {
|
|
| 816 |
my ( $foundScope, $id, $rev ) = split( /\./, $docid ); |
|
| 817 |
$id++; |
|
| 818 |
$docid = "$scope.$id.1"; |
|
| 819 |
} |
|
| 820 |
debug("Metcat handed us a new docid: $docid");
|
|
| 821 |
return $docid; |
|
| 822 |
} |
|
| 22 |
counter="0" |
|
| 823 | 23 |
|
| 824 |
sub incrementRevision {
|
|
| 825 |
my $initDocid = shift; |
|
| 826 |
my $docid = ''; |
|
| 827 |
if ( !$initDocid ) {
|
|
| 828 |
debug("No docid entered.");
|
|
| 829 |
} |
|
| 830 |
else {
|
|
| 831 |
my ( $scope, $id, $rev ) = split( /\./, $initDocid ); |
|
| 832 |
$rev++; |
|
| 833 |
$docid = "$scope.$id.$rev"; |
|
| 834 |
} |
|
| 835 |
return $docid; |
|
| 836 |
} |
|
| 24 |
while [ $counter -lt 3 ] |
|
| 25 |
do |
|
| 26 |
details=$(tail -n+$counter fileDetails.txt | head -n1) |
|
| 837 | 27 |
|
| 838 |
################################################################################ |
|
| 839 |
# |
|
| 840 |
# Validate the parameters to make sure that required params are provided |
|
| 841 |
# |
|
| 842 |
################################################################################ |
|
| 843 |
sub validateParameters {
|
|
| 844 |
my $chkUser = shift; |
|
| 845 |
my @invalidParams; |
|
| 28 |
#Get the variables needed for the confirmation stage |
|
| 29 |
commaLoc=`gexpr index $details ","` |
|
| 30 |
upload=${details:0:commaLoc-1}
|
|
| 846 | 31 |
|
| 847 |
push( @invalidParams, "Name of the Project is not selected in the form." ) |
|
| 848 |
if ( scalar(@FORM::wg) == 0 && $required->{'wgList'} eq 'true' );
|
|
| 849 |
push( @invalidParams, "First name of person entering the form is missing." ) |
|
| 850 |
unless hasContent($FORM::providerGivenName); |
|
| 851 |
push( @invalidParams, "Last name of person entering the form is missing." ) |
|
| 852 |
unless hasContent($FORM::providerSurName); |
|
| 853 |
push( @invalidParams, "Dataset title is missing." ) |
|
| 854 |
unless hasContent($FORM::title); |
|
| 855 |
push( @invalidParams, ucfirst( $config->{'site'} ) . " name is missing." )
|
|
| 856 |
unless ( ( hasContent($FORM::site) && !( $FORM::site =~ /^Select/ ) ) |
|
| 857 |
|| $skinName eq "nceas" ); |
|
| 858 |
push( @invalidParams, "First name of principal data set owner is missing." ) |
|
| 859 |
unless hasContent($FORM::origNamefirst0); |
|
| 860 |
push( @invalidParams, "Last name of principal data set owner is missing." ) |
|
| 861 |
unless hasContent($FORM::origNamelast0); |
|
| 862 |
push( @invalidParams, "Dataset abstract is missing." ) |
|
| 863 |
unless hasContent($FORM::abstract); |
|
| 32 |
details=${details:commaLoc}
|
|
| 33 |
commaLoc=`gexpr index $details ","` |
|
| 34 |
uploadname=${details:0:commaLoc-1}
|
|
| 864 | 35 |
|
| 865 |
if ( $modules->{'temporal'} eq 'true' ) {
|
|
| 866 |
push( @invalidParams, "Year of start date is missing." ) |
|
| 867 |
unless ( hasContent($FORM::beginningYear) |
|
| 868 |
|| $required->{'temporal'} ne 'true' );
|
|
| 869 |
push( @invalidParams, |
|
| 870 |
"Year of stop date has been specified but year of start date is missing." |
|
| 871 |
) |
|
| 872 |
if ( ( !hasContent($FORM::beginningYear) ) |
|
| 873 |
&& hasContent($FORM::endingYear) ); |
|
| 874 |
} |
|
| 875 |
push( @invalidParams, "Geographic description is missing." ) |
|
| 876 |
unless ( hasContent($FORM::geogdesc) |
|
| 877 |
|| $required->{'spatial'} ne 'true' );
|
|
| 36 |
details=${details:commaLoc}
|
|
| 37 |
commaLoc=`gexpr index $details ","` |
|
| 38 |
uploadtype=${details:0:commaLoc-1}
|
|
| 878 | 39 |
|
| 879 |
if ( $FORM::beginningMonth eq "MM" ) {
|
|
| 880 |
$FORM::beginningMonth = ""; |
|
| 881 |
} |
|
| 882 |
if ( $FORM::beginningDay eq "DD" ) {
|
|
| 883 |
$FORM::beginningDay = ""; |
|
| 884 |
} |
|
| 885 |
if ( $FORM::endingMonth eq "MM" ) {
|
|
| 886 |
$FORM::endingMonth = ""; |
|
| 887 |
} |
|
| 888 |
if ( $FORM::endingDay eq "DD" ) {
|
|
| 889 |
$FORM::endingDay = ""; |
|
| 890 |
} |
|
| 40 |
curl -X POST --cookie "JSESSIONID=81E77F52A2CA1D632B6CF01925D54FE0;SESS6790668dc29fdba8b64e6f4c1193c83d=yRZg3Ap9kK1TJGef_oOsPu4nMUe_SMEB8ICQrpsuOHI;CGISESSID=5c43858469558146ec0439e5b20500fd" --form file_0=@testdata.csv --form cfg=metacatui --form stage=confirmed --form providerGivenName=Lauren --form providerSurName=Walker --form "title=test with curl $counter" --form site=NCEAS --form origNamefirst0=walker --form origNamelast0=Walker --form abstract=abstract --form beginningYear=2014 --form geogdesc=Cali --form latDeg1=0 --form longDeg1=0 --form dataMedium=digital --form "useConstraints=no restrictions" --form useOrigAddress=on --form fileCount=1 --form upCount=1 --form delCount=1 --form uploadperm_0=public --form upload_0=$upload --form uploadname_0=$uploadname --form uploadtype_0=$uploadtype "https://dev.nceas.ucsb.edu/knb/cgi-bin/register-dataset.cgi" & |
|
| 891 | 41 |
|
| 892 |
if ( hasContent($FORM::beginningYear) |
|
| 893 |
&& !( $FORM::beginningYear =~ /[0-9]{4}/ ) )
|
|
| 894 |
{
|
|
| 895 |
push( @invalidParams, "Invalid year of start date specified." ); |
|
| 896 |
} |
|
| 42 |
counter=$[$counter+1] |
|
| 43 |
done |
|
| 897 | 44 |
|
| 898 |
if ( hasContent($FORM::endingYear) && !( $FORM::endingYear =~ /[0-9]{4}/ ) )
|
|
| 899 |
{
|
|
| 900 |
push( @invalidParams, "Invalid year of stop date specified." ); |
|
| 901 |
} |
|
| 902 |
|
|
| 903 |
# If the "use site" coord. box is checked and if the site is in |
|
| 904 |
# the longitude hash ... && ($siteLatDMS{$FORM::site})
|
|
| 905 |
|
|
| 906 |
if ( $modules->{'spatial'} eq 'true' ) {
|
|
| 907 |
if ( ($FORM::useSiteCoord) && ( $siteLatDMS{$FORM::site} ) ) {
|
|
| 908 |
$latDeg1 = $siteLatDMS{$FORM::site}[0];
|
|
| 909 |
$latMin1 = $siteLatDMS{$FORM::site}[1];
|
|
| 910 |
$latSec1 = $siteLatDMS{$FORM::site}[2];
|
|
| 911 |
$hemisphLat1 = $siteLatDMS{$FORM::site}[3];
|
|
| 912 |
$longDeg1 = $siteLongDMS{$FORM::site}[0];
|
|
| 913 |
$longMin1 = $siteLongDMS{$FORM::site}[1];
|
|
| 914 |
$longSec1 = $siteLongDMS{$FORM::site}[2];
|
|
| 915 |
$hemisphLong1 = $siteLongDMS{$FORM::site}[3];
|
|
| 916 |
} |
|
| 917 |
else {
|
|
| 918 |
$latDeg1 = $FORM::latDeg1; |
|
| 919 |
$latMin1 = $FORM::latMin1; |
|
| 920 |
$latSec1 = $FORM::latSec1; |
|
| 921 |
$hemisphLat1 = $FORM::hemisphLat1; |
|
| 922 |
$longDeg1 = $FORM::longDeg1; |
|
| 923 |
$longMin1 = $FORM::longMin1; |
|
| 924 |
$longSec1 = $FORM::longSec1; |
|
| 925 |
$hemisphLong1 = $FORM::hemisphLong1; |
|
| 926 |
} |
|
| 927 |
|
|
| 928 |
if ( $latDeg1 > 90 || $latDeg1 < 0 ) {
|
|
| 929 |
push( @invalidParams, "Invalid first latitude degrees specified." ); |
|
| 930 |
} |
|
| 931 |
if ( $latMin1 > 59 || $latMin1 < 0 ) {
|
|
| 932 |
push( @invalidParams, "Invalid first latitude minutes specified." ); |
|
| 933 |
} |
|
| 934 |
if ( $latSec1 > 59 || $latSec1 < 0 ) {
|
|
| 935 |
push( @invalidParams, "Invalid first latitude seconds specified." ); |
|
| 936 |
} |
|
| 937 |
if ( $longDeg1 > 180 || $longDeg1 < 0 ) {
|
|
| 938 |
push( @invalidParams, |
|
| 939 |
"Invalid first longitude degrees specified." ); |
|
| 940 |
} |
|
| 941 |
if ( $longMin1 > 59 || $longMin1 < 0 ) {
|
|
| 942 |
push( @invalidParams, |
|
| 943 |
"Invalid first longitude minutes specified." ); |
|
| 944 |
} |
|
| 945 |
if ( $longSec1 > 59 || $longSec1 < 0 ) {
|
|
| 946 |
push( @invalidParams, |
|
| 947 |
"Invalid first longitude seconds specified." ); |
|
| 948 |
} |
|
| 949 |
|
|
| 950 |
if ( hasContent($FORM::latDeg2) |
|
| 951 |
&& ( $FORM::latDeg2 > 90 || $FORM::latDeg2 < 0 ) ) |
|
| 952 |
{
|
|
| 953 |
push( @invalidParams, |
|
| 954 |
"Invalid second latitude degrees specified." ); |
|
| 955 |
} |
|
| 956 |
if ( hasContent($FORM::latMin2) |
|
| 957 |
&& ( $FORM::latMin2 > 59 || $FORM::latMin2 < 0 ) ) |
|
| 958 |
{
|
|
| 959 |
push( @invalidParams, |
|
| 960 |
"Invalid second latitude minutes specified." ); |
|
| 961 |
} |
|
| 962 |
if ( hasContent($FORM::latSec2) |
|
| 963 |
&& ( $FORM::latSec2 > 59 || $FORM::latSec2 < 0 ) ) |
|
| 964 |
{
|
|
| 965 |
push( @invalidParams, |
|
| 966 |
"Invalid second latitude seconds specified." ); |
|
| 967 |
} |
|
| 968 |
if ( hasContent($FORM::latDeg2) |
|
| 969 |
&& ( $FORM::longDeg2 > 180 || $FORM::longDeg2 < 0 ) ) |
|
| 970 |
{
|
|
| 971 |
push( @invalidParams, |
|
| 972 |
"Invalid second longitude degrees specified." ); |
|
| 973 |
} |
|
| 974 |
if ( hasContent($FORM::latMin2) |
|
| 975 |
&& ( $FORM::longMin2 > 59 || $FORM::longMin2 < 0 ) ) |
|
| 976 |
{
|
|
| 977 |
push( @invalidParams, |
|
| 978 |
"Invalid second longitude minutes specified." ); |
|
| 979 |
} |
|
| 980 |
if ( hasContent($FORM::latSec2) |
|
| 981 |
&& ( $FORM::longSec2 > 59 || $FORM::longSec2 < 0 ) ) |
|
| 982 |
{
|
|
| 983 |
push( @invalidParams, |
|
| 984 |
"Invalid second longitude seconds specified." ); |
|
| 985 |
} |
|
| 986 |
} |
|
| 987 |
|
|
| 988 |
# Check if latDeg1 and longDeg1 has values if useSiteCoord is used. |
|
| 989 |
# This check is required because some of the sites dont have lat |
|
| 990 |
# and long mentioned in the config file. |
|
| 991 |
|
|
| 992 |
if ( $modules->{'spatial'} eq 'true' && $required->{'spatial'} eq 'true' ) {
|
|
| 993 |
if ($FORM::useSiteCoord) {
|
|
| 994 |
push( @invalidParams, |
|
| 995 |
"The Data Registry doesn't have latitude and longitude information for the site that you chose. Please go back and enter the spatial information." |
|
| 996 |
) unless ( hasContent($latDeg1) && hasContent($longDeg1) ); |
|
| 997 |
} |
|
| 998 |
else {
|
|
| 999 |
push( @invalidParams, "Latitude degrees are missing." ) |
|
| 1000 |
unless ( hasContent($latDeg1) |
|
| 1001 |
|| $required->{'spatial'} ne 'true' );
|
|
| 1002 |
push( @invalidParams, "Longitude degrees are missing." ) |
|
| 1003 |
unless ( hasContent($longDeg1) |
|
| 1004 |
|| $required->{'spatial'} ne 'true' );
|
|
| 1005 |
} |
|
| 1006 |
push( @invalidParams, |
|
| 1007 |
"You must provide a geographic description if you provide latitude and longitude information." |
|
| 1008 |
) |
|
| 1009 |
if ( ( hasContent($latDeg1) || ( hasContent($longDeg1) ) ) |
|
| 1010 |
&& ( !hasContent($FORM::geogdesc) ) ); |
|
| 1011 |
} |
|
| 1012 |
|
|
| 1013 |
if ( $modules->{'method'} eq 'true' ) {
|
|
| 1014 |
push( @invalidParams, |
|
| 1015 |
"You must provide a method description if you provide a method title." |
|
| 1016 |
) |
|
| 1017 |
if ( |
|
| 1018 |
hasContent($FORM::methodTitle) |
|
| 1019 |
&& ( !( scalar(@FORM::methodPara) > 0 ) |
|
| 1020 |
|| ( !hasContent( $FORM::methodPara[0] ) ) ) |
|
| 1021 |
); |
|
| 1022 |
push( @invalidParams, |
|
| 1023 |
"You must provide a method description if you provide an extent of study description." |
|
| 1024 |
) |
|
| 1025 |
if ( |
|
| 1026 |
hasContent($FORM::studyExtentDescription) |
|
| 1027 |
&& ( !( scalar(@FORM::methodPara) > 0 ) |
|
| 1028 |
|| ( !hasContent( $FORM::methodPara[0] ) ) ) |
|
| 1029 |
); |
|
| 1030 |
push( @invalidParams, |
|
| 1031 |
"You must provide both an extent of study description and a sampling description, or neither." |
|
| 1032 |
) |
|
| 1033 |
if ( |
|
| 1034 |
( |
|
| 1035 |
hasContent($FORM::studyExtentDescription) |
|
| 1036 |
&& !hasContent($FORM::samplingDescription) |
|
| 1037 |
) |
|
| 1038 |
|| ( !hasContent($FORM::studyExtentDescription) |
|
| 1039 |
&& hasContent($FORM::samplingDescription) ) |
|
| 1040 |
); |
|
| 1041 |
} |
|
| 1042 |
|
|
| 1043 |
if ( $modules->{'upload'} eq 'true' ) {
|
|
| 1044 |
for ( my $upNum = 0 ; $upNum <= $FORM::upCount ; $upNum++ ) {
|
|
| 1045 |
my $upn = "upload_$upNum"; |
|
| 1046 |
if ( hasContent( param($upn) ) |
|
| 1047 |
&& !grep { $_ eq ("uploadname_$upNum") } @FORM::deletefile )
|
|
| 1048 |
{
|
|
| 1049 |
push( @invalidParams, |
|
| 1050 |
"Must select a permission for file " |
|
| 1051 |
. param("uploadname_$upNum") )
|
|
| 1052 |
if ( !hasContent( param("uploadperm_$upNum") ) );
|
|
| 1053 |
} |
|
| 1054 |
} |
|
| 1055 |
} |
|
| 1056 |
|
|
| 1057 |
push( @invalidParams, "First name of data set contact is missing." ) |
|
| 1058 |
unless ( hasContent($FORM::origNamefirstContact) |
|
| 1059 |
|| $FORM::useOrigAddress ); |
|
| 1060 |
push( @invalidParams, "Last name of data set contact is missing." ) |
|
| 1061 |
unless ( hasContent($FORM::origNamelastContact) |
|
| 1062 |
|| $FORM::useOrigAddress ); |
|
| 1063 |
if ( $required->{'contactEmailAddress'} eq 'true' ) {
|
|
| 1064 |
if ($FORM::useOrigAddress) {
|
|
| 1065 |
push( @invalidParams, |
|
| 1066 |
"Email address of data set owner is missing. This is required as it will be used as contact email address as specified by you." |
|
| 1067 |
) unless ( hasContent($FORM::origEmail) ); |
|
| 1068 |
} |
|
| 1069 |
else {
|
|
| 1070 |
push( @invalidParams, |
|
| 1071 |
"Email address of data set contact is missing." ) |
|
| 1072 |
unless ( hasContent($FORM::origEmailContact) ); |
|
| 1073 |
} |
|
| 1074 |
} |
|
| 1075 |
|
|
| 1076 |
# check required distribution elements |
|
| 1077 |
push( @invalidParams, "Data medium is required." ) |
|
| 1078 |
unless ( hasContent($FORM::dataMedium) ); |
|
| 1079 |
if ( $FORM::dataMedium eq 'other' ) {
|
|
| 1080 |
push( @invalidParams, |
|
| 1081 |
"Must enter custom data medium when 'other' is selected." ) |
|
| 1082 |
unless ( hasContent($FORM::dataMediumOther) ); |
|
| 1083 |
} |
|
| 1084 |
push( @invalidParams, "Usage rights are required." ) |
|
| 1085 |
unless ( hasContent($FORM::useConstraints) ); |
|
| 1086 |
if ( $FORM::useConstraints eq 'other' ) {
|
|
| 1087 |
push( @invalidParams, |
|
| 1088 |
"Must enter custom usage rights when 'other' is selected." ) |
|
| 1089 |
unless ( hasContent($FORM::useConstraintsOther) ); |
|
| 1090 |
} |
|
| 1091 |
|
|
| 1092 |
return \@invalidParams; |
|
| 1093 |
} |
|
| 1094 |
|
|
| 1095 |
################################################################################ |
|
| 1096 |
# |
|
| 1097 |
# utility function to determine if a paramter is defined and not an empty string |
|
| 1098 |
# |
|
| 1099 |
################################################################################ |
|
| 1100 |
sub hasContent {
|
|
| 1101 |
my $param = shift; |
|
| 1102 |
|
|
| 1103 |
my $paramHasContent; |
|
| 1104 |
if ( !defined($param) || $param eq '' ) {
|
|
| 1105 |
$paramHasContent = 0; |
|
| 1106 |
} |
|
| 1107 |
else {
|
|
| 1108 |
$paramHasContent = 1; |
|
| 1109 |
} |
|
| 1110 |
return $paramHasContent; |
|
| 1111 |
} |
|
| 1112 |
|
|
| 1113 |
################################################################################ |
|
| 1114 |
# |
|
| 1115 |
# Subroutine for replacing characters not recognizable by XML and otherwise. |
|
| 1116 |
# |
|
| 1117 |
################################################################################ |
|
| 1118 |
sub normalize {
|
|
| 1119 |
my $val = shift; |
|
| 1120 |
|
|
| 1121 |
$val =~ s/&/&/g; |
|
| 1122 |
|
|
| 1123 |
$val =~ s/</</g; |
|
| 1124 |
$val =~ s/>/>/g; |
|
| 1125 |
$val =~ s/\"/"/g; |
|
| 1126 |
$val =~ s/%/%/g; |
|
| 1127 |
|
|
| 1128 |
my $returnVal = ""; |
|
| 1129 |
|
|
| 1130 |
foreach ( split( //, $val ) ) {
|
|
| 1131 |
my $var = unpack "C*", $_; |
|
| 1132 |
|
|
| 1133 |
if ( $var < 128 && $var > 31 ) {
|
|
| 1134 |
$returnVal = $returnVal . $_; |
|
| 1135 |
} |
|
| 1136 |
elsif ( $var < 32 ) {
|
|
| 1137 |
if ( $var == 10 ) {
|
|
| 1138 |
$returnVal = $returnVal . $_; |
|
| 1139 |
} |
|
| 1140 |
if ( $var == 13 ) {
|
|
| 1141 |
$returnVal = $returnVal . $_; |
|
| 1142 |
} |
|
| 1143 |
if ( $var == 9 ) {
|
|
| 1144 |
$returnVal = $returnVal . $_; |
|
| 1145 |
} |
|
| 1146 |
} |
|
| 1147 |
else {
|
|
| 1148 |
$returnVal = $returnVal . $_; |
|
| 1149 |
} |
|
| 1150 |
} |
|
| 1151 |
|
|
| 1152 |
return $returnVal; |
|
| 1153 |
} |
|
| 1154 |
|
|
| 1155 |
################################################################################ |
|
| 1156 |
# |
|
| 1157 |
# Subroutine for replacing characters not recognizable by XML and otherwise |
|
| 1158 |
# except for ", > amd <. |
|
| 1159 |
# |
|
| 1160 |
################################################################################ |
|
| 1161 |
sub delNormalize {
|
|
| 1162 |
my $val = shift; |
|
| 1163 |
|
|
| 1164 |
$val =~ s/&/&/g; |
|
| 1165 |
|
|
| 1166 |
$val =~ s/%/%/g; |
|
| 1167 |
|
|
| 1168 |
my $returnVal = ""; |
|
| 1169 |
|
|
| 1170 |
foreach ( split( //, $val ) ) {
|
|
| 1171 |
my $var = unpack "C*", $_; |
|
| 1172 |
|
|
| 1173 |
if ( $var < 128 && $var > 31 ) {
|
|
| 1174 |
$returnVal = $returnVal . $_; |
|
| 1175 |
} |
|
| 1176 |
elsif ( $var < 32 ) {
|
|
| 1177 |
if ( $var == 10 ) {
|
|
| 1178 |
$returnVal = $returnVal . $_; |
|
| 1179 |
} |
|
| 1180 |
if ( $var == 13 ) {
|
|
| 1181 |
$returnVal = $returnVal . $_; |
|
| 1182 |
} |
|
| 1183 |
if ( $var == 9 ) {
|
|
| 1184 |
$returnVal = $returnVal . $_; |
|
| 1185 |
} |
|
| 1186 |
} |
|
| 1187 |
else {
|
|
| 1188 |
$returnVal = $returnVal . "&#" . $var . ";"; |
|
| 1189 |
} |
|
| 1190 |
} |
|
| 1191 |
|
|
| 1192 |
$returnVal =~ s/&/%26/g; |
|
| 1193 |
return $returnVal; |
|
| 1194 |
} |
|
| 1195 |
|
|
| 1196 |
################################################################################ |
|
| 1197 |
# |
|
| 1198 |
# Subroutine for replacing characters that might create problem in HTML. |
|
| 1199 |
# Specifically written for " being used in any text field. This creates a |
|
| 1200 |
# problem in confirmData template, when you specify input name value pair |
|
| 1201 |
# with value having a " in it. |
|
| 1202 |
# |
|
| 1203 |
################################################################################ |
|
| 1204 |
sub normalizeCD {
|
|
| 1205 |
my $val = shift; |
|
| 1206 |
|
|
| 1207 |
$val =~ s/\"/"/g; |
|
| 1208 |
|
|
| 1209 |
return $val; |
|
| 1210 |
} |
|
| 1211 |
|
|
| 1212 |
################################################################################ |
|
| 1213 |
# |
|
| 1214 |
# Upload new file objects into Metacat, if they're present and valid. |
|
| 1215 |
# |
|
| 1216 |
################################################################################ |
|
| 1217 |
sub allFileData {
|
|
| 1218 |
my %uploadedFiles = (); |
|
| 1219 |
my $fileInfo; |
|
| 1220 |
my $docid; |
|
| 1221 |
|
|
| 1222 |
for ( my $fileNum = 0 ; $fileNum <= $FORM::upCount ; $fileNum++ ) {
|
|
| 1223 |
my $fn = 'upload_' . $fileNum; |
|
| 1224 |
if ( hasContent( param($fn) ) ) {
|
|
| 1225 |
|
|
| 1226 |
# ignore data which is scheduled for deletion |
|
| 1227 |
if ( grep { $_ eq ("uploadname_$fileNum") } @FORM::deletefile ) {
|
|
| 1228 |
debug( |
|
| 1229 |
"Not generating metadata for file scheduled for deletion: $fn" |
|
| 1230 |
); |
|
| 1231 |
} |
|
| 1232 |
else {
|
|
| 1233 |
debug("Retrieving metadata for file: $fn");
|
|
| 1234 |
( $docid, $fileInfo ) = fileMetadata($fileNum); |
|
| 1235 |
$uploadedFiles{$docid} = $fileInfo;
|
|
| 1236 |
} |
|
| 1237 |
} |
|
| 1238 |
} |
|
| 1239 |
|
|
| 1240 |
return %uploadedFiles; |
|
| 1241 |
} |
|
| 1242 |
|
|
| 1243 |
sub fileMetadata {
|
|
| 1244 |
my $fileNum = shift; |
|
| 1245 |
my $fileHash = param("upload_$fileNum");
|
|
| 1246 |
my $fileName = param("uploadname_$fileNum");
|
|
| 1247 |
my $contentType = param("uploadtype_$fileNum");
|
|
| 1248 |
my $filePerm = param("uploadperm_$fileNum");
|
|
| 1249 |
my $docid; |
|
| 1250 |
my $outFile; |
|
| 1251 |
my $cleanName = $fileName; |
|
| 1252 |
|
|
| 1253 |
# process an _existing_ data file, which is already within Metacat. |
|
| 1254 |
if ( $fileHash =~ /ondisk/ ) {
|
|
| 1255 |
( $docid, $fileHash ) = datafileInfo($fileHash); |
|
| 1256 |
$outFile = $dataDir . "/" . $docid; |
|
| 1257 |
} |
|
| 1258 |
else {
|
|
| 1259 |
|
|
| 1260 |
# normalize input filenames; Windows filenames include full paths |
|
| 1261 |
$cleanName =~ s/.*[\/\\](.*)/$1/; |
|
| 1262 |
$outFile = $tempDir . "/" . $cleanName; |
|
| 1263 |
} |
|
| 1264 |
debug("Reading file from disk: $outFile");
|
|
| 1265 |
|
|
| 1266 |
my $fileSize = stat($outFile)->size; |
|
| 1267 |
if ( $fileSize == 0 ) {
|
|
| 1268 |
push( @errorMessages, "file $fileName is zero bytes!" ); |
|
| 1269 |
debug("File $fileName is zero bytes!");
|
|
| 1270 |
} |
|
| 1271 |
|
|
| 1272 |
# Now the file is on disk, send the object to Metacat |
|
| 1273 |
my $session = CGI::Session->load(); |
|
| 1274 |
if ( $session->is_empty ) {
|
|
| 1275 |
push( @errorMessages, "Must be logged in to upload files." ); |
|
| 1276 |
debug("Not logged in, cannot upload files.");
|
|
| 1277 |
return 0; |
|
| 1278 |
} |
|
| 1279 |
|
|
| 1280 |
# remove the uniqueness of the filename |
|
| 1281 |
# 'tempXXXXX' |
|
| 1282 |
$cleanName = substr($cleanName, 9); |
|
| 1283 |
|
|
| 1284 |
if ( !$docid ) {
|
|
| 1285 |
$docid = newAccessionNumber( $config->{'scope'}, $metacat );
|
|
| 1286 |
my $uploadReturn = uploadData( $outFile, $docid, $cleanName ); |
|
| 1287 |
if ( !$uploadReturn ) {
|
|
| 1288 |
debug("Uploading the data failed.");
|
|
| 1289 |
} |
|
| 1290 |
} |
|
| 1291 |
my $entityid = $fileHash . "001"; |
|
| 1292 |
my $distribid = $fileHash . "002"; |
|
| 1293 |
|
|
| 1294 |
my $uploadUrl = 'ecogrid://knb/' . $docid; |
|
| 1295 |
|
|
| 1296 |
# TODO: should match the object promotion path, so that an |
|
| 1297 |
# Excel upload results in 'dataTable' in this field |
|
| 1298 |
my $entityType = 'Other'; |
|
| 1299 |
|
|
| 1300 |
my %dataInfo = ( |
|
| 1301 |
'docid' => $docid, |
|
| 1302 |
'entityid' => $entityid, |
|
| 1303 |
'distribid' => $distribid, |
|
| 1304 |
'fileName' => $cleanName, |
|
| 1305 |
'fileSize' => $fileSize, |
|
| 1306 |
'fileHash' => $fileHash, |
|
| 1307 |
'filePerm' => $filePerm, |
|
| 1308 |
'contentType' => $contentType, |
|
| 1309 |
'url' => $uploadUrl, |
|
| 1310 |
'entityType' => $entityType, |
|
| 1311 |
); |
|
| 1312 |
|
|
| 1313 |
return ( $docid, \%dataInfo ); |
|
| 1314 |
} |
|
| 1315 |
|
|
| 1316 |
sub datafileInfo {
|
|
| 1317 |
my $finfo = shift; |
|
| 1318 |
$finfo =~ s/ondisk://g; |
|
| 1319 |
return my ( $docid, $fileHash ) = split( ":", $finfo ); |
|
| 1320 |
} |
|
| 1321 |
|
|
| 1322 |
sub processFile {
|
|
| 1323 |
my $fileName = shift; |
|
| 1324 |
|
|
| 1325 |
# test that we actually got a file |
|
| 1326 |
if ( !$fileName || cgi_error() ) {
|
|
| 1327 |
debug( "Error receiving file " . cgi_error() ); |
|
| 1328 |
} |
|
| 1329 |
|
|
| 1330 |
# write file to disk, get SHA1 hash and size |
|
| 1331 |
my ( $outFile, $fileHash ) = writeFile($fileName); |
|
| 1332 |
debug( "processed file to temp directory: $outFile" ); |
|
| 1333 |
|
|
| 1334 |
my $fileSize = stat($outFile)->size; |
|
| 1335 |
if ( $fileSize == 0 ) {
|
|
| 1336 |
push( @errorMessages, "file $fileName is zero bytes!" ); |
|
| 1337 |
debug("File $fileName is zero bytes!");
|
|
| 1338 |
} |
|
| 1339 |
|
|
| 1340 |
# file is in Metacat, generate the pertinent EML elements |
|
| 1341 |
my $contentType = uploadInfo($fileName)->{'Content-Type'};
|
|
| 1342 |
|
|
| 1343 |
# occasionally CGI.pm doesn't get the file info. In this case, |
|
| 1344 |
# use a default MIME type of text/plain. Seems fixed in the newer CGI.pm: |
|
| 1345 |
# http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=313141 |
|
| 1346 |
if ( !$contentType ) {
|
|
| 1347 |
$contentType = 'text/plain'; |
|
| 1348 |
} |
|
| 1349 |
|
|
| 1350 |
my %dataInfo = ( |
|
| 1351 |
'fileName' => $outFile, |
|
| 1352 |
'fileHash' => $fileHash, |
|
| 1353 |
'contentType' => $contentType, |
|
| 1354 |
); |
|
| 1355 |
|
|
| 1356 |
return \%dataInfo; |
|
| 1357 |
} |
|
| 1358 |
|
|
| 1359 |
sub writeFile {
|
|
| 1360 |
my $fileName = shift; |
|
| 1361 |
my $fileData; |
|
| 1362 |
my $length = 0; |
|
| 1363 |
my $buffer; |
|
| 1364 |
|
|
| 1365 |
my $cleanName = $fileName; |
|
| 1366 |
|
|
| 1367 |
# normalize input filenames; Windows filenames include full paths |
|
| 1368 |
$cleanName =~ s/.*[\/\\](.*)/$1/; |
|
| 1369 |
|
|
| 1370 |
while ( my $bytesRead = read( $fileName, $buffer, 4096 ) ) {
|
|
| 1371 |
$fileData .= $buffer; |
|
| 1372 |
$length += $bytesRead; |
|
| 1373 |
} |
|
| 1374 |
|
|
| 1375 |
# create SHA1 sum to store file hash |
|
| 1376 |
my $ctx = Digest::SHA1->new; |
|
| 1377 |
$ctx->add($fileData); |
|
| 1378 |
my $digest = $ctx->hexdigest; |
|
| 1379 |
|
|
| 1380 |
# use tempfile for writing |
|
| 1381 |
my $tmp = File::Temp->new( |
|
| 1382 |
TEMPLATE => 'tempXXXXX', |
|
| 1383 |
DIR => $tempDir, |
|
| 1384 |
SUFFIX => $cleanName, |
|
| 1385 |
UNLINK => 0); |
|
| 1386 |
my $outputName = $tmp->filename(); |
|
| 1387 |
#open( OUT, ">$outputName" ) or die "Could not open: $!"; |
|
| 1388 |
print $tmp $fileData; |
|
| 1389 |
close($tmp); |
|
| 1390 |
debug("Writing output, result is: $outputName");
|
|
| 1391 |
|
|
| 1392 |
return ( $outputName, $digest ); |
|
| 1393 |
} |
|
| 1394 |
|
|
| 1395 |
sub deleteRemovedData {
|
|
| 1396 |
|
|
| 1397 |
# if we have any associated datafiles which are scheduled for deletion, remove them now |
|
| 1398 |
for ( my $delNum = 0 ; $delNum <= $FORM::delCount ; $delNum++ ) {
|
|
| 1399 |
|
|
| 1400 |
# need to look up the actual upload number, which is contained in the name |
|
| 1401 |
my $upNum = param("deletefile_$delNum");
|
|
| 1402 |
$upNum =~ s/uploadname_//; |
|
| 1403 |
my $upn = param("upload_$upNum");
|
|
| 1404 |
if ( hasContent($upn) ) {
|
|
| 1405 |
debug("Deleting upload_$upNum, $upn");
|
|
| 1406 |
if ( grep { $_ eq ("uploadname_$upNum") } @FORM::deletefile ) {
|
|
| 1407 |
if ( param("upload_$upNum") =~ /ondisk/ ) {
|
|
| 1408 |
debug( |
|
| 1409 |
"got a file which is ondisk, proceeding with deletion"); |
|
| 1410 |
deleteFileData( param("upload_$upNum") );
|
|
| 1411 |
} |
|
| 1412 |
else {
|
|
| 1413 |
debug( |
|
| 1414 |
"got an old reference, not yet in EML, remove from tempdir" |
|
| 1415 |
); |
|
| 1416 |
deleteFile( param("uploadname_$upNum") );
|
|
| 1417 |
} |
|
| 1418 |
} |
|
| 1419 |
else {
|
|
| 1420 |
debug("Name didn't match in deletefile list");
|
|
| 1421 |
} |
|
| 1422 |
} |
|
| 1423 |
} |
|
| 1424 |
} |
|
| 1425 |
|
|
| 1426 |
sub deleteFile {
|
|
| 1427 |
my $input = shift; |
|
| 1428 |
#my $fileName = $tempDir . "/" . $input; |
|
| 1429 |
my $fileName = $input; |
|
| 1430 |
|
|
| 1431 |
if ( -e $fileName ) {
|
|
| 1432 |
unlink $fileName |
|
| 1433 |
or debug("Failed to delete file $fileName.");
|
|
| 1434 |
} |
|
| 1435 |
else {
|
|
| 1436 |
debug("Unable to find file $fileName");
|
|
| 1437 |
} |
|
| 1438 |
if ( !-e $fileName ) {
|
|
| 1439 |
debug("Successfully deleted $fileName");
|
|
| 1440 |
} |
|
| 1441 |
} |
|
| 1442 |
|
|
| 1443 |
sub deleteFileData {
|
|
| 1444 |
my $input = shift; |
|
| 1445 |
my ( $docid, $fileHash ) = datafileInfo($input); |
|
| 1446 |
my $metacat = Metacat->new($metacatUrl); |
|
| 1447 |
|
|
| 1448 |
my ( $username, $password ) = getCredentials(); |
|
| 1449 |
my $response = $metacat->login( $username, $password ); |
|
| 1450 |
if ( !$response ) {
|
|
| 1451 |
my $msg = $metacat->getMessage(); |
|
| 1452 |
push( @errorMessages, |
|
| 1453 |
"Failed to login with credentials for `$username`. Error was $msg" |
|
| 1454 |
); |
|
| 1455 |
debug( |
|
| 1456 |
"Failed to login with given credentials for username $username, Error is: $msg" |
|
| 1457 |
); |
|
| 1458 |
} |
|
| 1459 |
else {
|
|
| 1460 |
$response = $metacat->delete($docid); |
|
| 1461 |
if ( !$response ) {
|
|
| 1462 |
my $msg = $metacat->getMessage(); |
|
| 1463 |
push( @errorMessages, |
|
| 1464 |
"Failed to delete existing file. Error was: $msg" ); |
|
| 1465 |
debug("Delete -- Error is: $msg");
|
|
| 1466 |
} |
|
| 1467 |
else {
|
|
Also available in: Unified diff
Fix bug in the online registry where data files were not using the new docid creation process