Project

General

Profile

« Previous | Next » 

Revision 8813

Fix bug in the online registry where data files were not using the new docid creation process

View differences:

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
	print
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/&/&amp;/g;
1122

  
1123
	$val =~ s/</&lt;/g;
1124
	$val =~ s/>/&gt;/g;
1125
	$val =~ s/\"/&quot;/g;
1126
	$val =~ s/%/&#37;/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/&/&amp;/g;
1165

  
1166
	$val =~ s/%/&#37;/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/\"/&quot;/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 {
... This diff was truncated because it exceeds the maximum size that can be displayed.

Also available in: Unified diff