Metacat

#!/usr/bin/env perl

#

#  '$RCSfile$'

#  Copyright: 2000 Regents of the University of California

#

#   '$Author$'

#     '$Date$'

# '$Revision$'

#

# This program is free software; you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation; either version 2 of the License, or

# (at your option) any later version.

#

# This program is distributed in the hope that it will be useful,

# but WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

# GNU General Public License for more details.

#

# You should have received a copy of the GNU General Public License

# along with this program; if not, write to the Free Software

# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#

# This is a CGI application for inserting metadata documents into

# the Metacat database.  It utilizes the Metacat.pm module for most work.

# In this script, we process the form fields passed in from a POST, insert a

# metadata document and an ACL document.

use lib '../WEB-INF/lib';

use Metacat;

use Config::Properties;

use Cwd 'abs_path';

use XML::LibXML;

use XML::LibXSLT;

use Template;

use Net::SMTP;

use CGI qw/:standard :html3/;

use CGI::Session;

use Digest::SHA1;

use File::stat;

use File::Basename;

use File::Temp;

use File::Copy;

use Fcntl qw(:flock);

use Data::UUID;

use strict;

#debug("running register-dataset.cgi");

# Global configuration paramters

my $cgiDir           = $ENV{'SCRIPT_FILENAME'};

my $workingDirectory = ".";

if ( $cgiDir ne "" ) {

	my $workingDirectory = dirname($cgiDir);

}

my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";

my $properties   = new Config::Properties();

unless ( open( METACAT_PROPERTIES, $metacatProps ) ) {

	print "Content-type: text/html\n\n";

	print

"Unable to locate Metacat properties. Working directory is set as '$workingDirectory', is this correct?";

	exit();

}

$properties->load(*METACAT_PROPERTIES);

# local directory configuration

my $skinsDir     = "${workingDirectory}/../style/skins";

my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");

my $tempDir      = $properties->getProperty('application.tempDir');

my $dataDir      = $properties->getProperty('application.datafilepath');

my $metacatDir   = "/var/metacat";

# url configuration

my $server = $properties->splitToTree( qr/\./, 'server' );

my $protocol = 'http://';

if ( $properties->getProperty('server.httpPort') eq '443' ) {

	$protocol = 'https://';

}

my $contextUrl = $protocol . $properties->getProperty('server.name');

if ( $properties->getProperty('server.httpPort') ne '80' ) {

	$contextUrl =

	  $contextUrl . ':' . $properties->getProperty('server.httpPort');

}

$contextUrl =

  $contextUrl . '/' . $properties->getProperty('application.context');

my $metacatUrl = $contextUrl . "/metacat";

my $cgiPrefix =

  "/" . $properties->getProperty('application.context') . "/cgi-bin";

my $styleSkinsPath  = $contextUrl . "/style/skins";

my $styleCommonPath = $contextUrl . "/style/common";

my $userManagementUrl = $properties->getProperty('auth.userManagementUrl');

my $now = time;

# Import all of the HTML form fields as variables

import_names('FORM');

# Must have a config to use Metacat

my $skinName = "";

if ( hasContent($FORM::cfg) ) {

	$skinName = $FORM::cfg;

}

elsif ( hasContent( $ARGV[0] ) ) {

	$skinName = $ARGV[0];

}

else {

	debug("No configuration set.");

	print "Content-type: text/html\n\n";

	'Registry Error: The registry requires a skin name to continue.';

	exit();

}

# Metacat isn't initialized, the registry will fail in strange ways.

if ( !hasContent($metacatUrl) ) {

	debug("No Metacat.");

	print "Content-type: text/html\n\n";

	'Registry Error: Metacat is not initialized! Make sure'

	  . ' MetacatUrl is set correctly in '

	  . $skinName

	  . '.properties';

	exit();

}

# Set up the hash for returning data to the HTML templates

my $templateVars = { 'status' => 'success' };

my $error = 0;

my @errorMessages;

my $skinProperties = new Config::Properties();

if ( !hasContent($skinName) ) {

	$error = "Application misconfigured.  Please contact the administrator.";

	push( @errorMessages, $error );

}

else {

	my $skinProps = "$skinsDir/$skinName/$skinName.properties";

	unless ( open( SKIN_PROPERTIES, $skinProps ) ) {

		print "Content-type: text/html\n\n";

		print "Unable to locate skin properties at $skinProps.  Is this path correct?";

		exit();

	}

	$skinProperties->load(*SKIN_PROPERTIES);

}

# replacements for appconfig values using properties

my $moderators = $properties->getProperty('auth.moderators');

my $config     = $skinProperties->splitToTree( qr/\./, 'registry.config' );

my $templates  = $skinProperties->splitToTree( qr/\./, 'registry.templates' );

my $modules    = $skinProperties->splitToTree( qr/\./, 'registry.modules' );

my $required   = $skinProperties->splitToTree( qr/\./, 'registry.required' );

my $spatial    = $skinProperties->splitToTree( qr/\./, 'registry.spatial' );

my $show       = $skinProperties->splitToTree( qr/\./, 'registry.show' );

# set stderr printing if configured

my $debug_enabled = $config->{'debug'};

if ($FORM::debug) {

	$debug_enabled = $FORM::debug;

}

# skin owner credentials

my $adminUsername = $config->{'username'};

my $adminPassword = $config->{'password'};

# contains sender, recipient, admin, mailhost

my $skinEmail = $skinProperties->splitToTree( qr/\./, 'email' );

my $email = $properties->splitToTree( qr/\./, 'email' );

# override email properties with skin-based ones

my @emailData = keys(%$email);

foreach my $d (@emailData) {

	if ( %$skinEmail->{$d} ) {

		$email->{$d} = %$skinEmail->{$d};

	}

}

# convert the lat and lon configs into usable data structures

my @sitelist;

my %siteLatDMS;

my %siteLongDMS;

while ( my ( $key, $value ) = each(%$spatial) ) {

	my ( $name, $lon, $lat ) = split( /\|/, $value );

	my ( $latd, $latm, $lats, $latdir ) = split( /\|/, $lat );

	my ( $lond, $lonm, $lons, $londir ) = split( /\|/, $lon );

	push( @sitelist, $name );

	$siteLatDMS{$name}  = [ $latd, $latm, $lats, $latdir ];

	$siteLongDMS{$name} = [ $lond, $lonm, $lons, $londir ];

}

# set some configuration options for the template object

my $ttConfig = {

	INCLUDE_PATH => $templatesDir,

	INTERPOLATE  => 0,

	POST_CHOMP   => 1,

	DEBUG        => 1,

};

# create an instance of the template processor

my $template = Template->new($ttConfig) || die $Template::ERROR, "\n";

#print "Content-type: text/html\n\n";

#print "Is debug enabled? `$debug_enabled`";

#use Data::Dumper;

#print Dumper($config);

#exit;

# Set up the template information that is common to all forms

$$templateVars{'contextUrl'}      = $contextUrl;

$$templateVars{'styleSkinsPath'}  = $styleSkinsPath;

$$templateVars{'styleCommonPath'} = $styleCommonPath;

$$templateVars{'cgiPrefix'}       = $cgiPrefix;

$$templateVars{'metacatUrl'}      = $metacatUrl;

$$templateVars{'cfg'}             = $skinName;

$$templateVars{'email'}           = $email;

$$templateVars{'templates'}       = $templates;

$$templateVars{'required'}        = $required;

$$templateVars{'config'}          = $config;

$$templateVars{'userManagementUrl'} = $userManagementUrl;

debug("Initialized -- stage set: $FORM::stage");

# handle pids, set the mapped docid in the FORM params

# see: https://projects.ecoinformatics.org/ecoinfo/issues/5932

debug("PID: $FORM::pid");

if ($FORM::pid ne "" ) {

	my $pid = $FORM::pid;

	my $metacat = Metacat->new($metacatUrl);

	my $docid = $metacat->getDocid($pid);

	$FORM::docid = $docid;

}

# Process the form based on stage parameter.

if ( $FORM::stage =~ "loginform" ) {

	print "Content-type: text/html\n\n";

	# Send back the login form.....

	my $session = CGI::Session->load() or die CGI::Session->errstr();

	if ( $FORM::submission eq 'true' ) {

		$$templateVars{'message'} = 'You must login to view your submissions.';

	}

	if ( !$session->is_empty ) {

		# session found ... delete the session....

		$session->delete();

	}

	$template->process( $templates->{'login'}, $templateVars );

	exit();

}

elsif ( $FORM::stage =~ "logout" ) {

	handleLogoutRequest();

	exit();

}

elsif ( $FORM::stage =~ "login" ) {

	handleLoginRequest();

	exit();

}

elsif ( $FORM::stage =~ "mod_accept" ) {

	handleModAccept();

	exit();

}

elsif ( $FORM::stage =~ "mod_decline" ) {

	handleModDecline();

	exit();

}

elsif ( $FORM::stage =~ "mod_revise" ) {

	handleModRevise();

	exit();

}

elsif ( $FORM::stage =~ "read" ) {

	handleRead();

	exit();

}

elsif ( $FORM::stage =~ "review_frame" ) {

	handleReviewFrame();

	exit();

}

print "Content-type: text/html\n\n";

if ( $FORM::stage =~ "guide" ) {

	# Send back the information on how to fill the form

	$$templateVars{'section'} = "Guide on How to Complete Registry Entries";

	$template->process( $templates->{'guide'}, $templateVars );

	exit();

}

elsif ( $FORM::stage =~ "insert" ) {

	# The user has entered the data. Do data validation and send back data

	# to confirm the data that has been entered.

	toConfirmData();

	exit();

}

elsif ($FORM::dataWrong =~ "No, go back to editing"

	&& $FORM::stage =~ "confirmed" )

{

	# The user wants to correct the data that he has entered.

	# Hence show the data again in entryData form.

	confirmDataToReEntryData();

	exit();

}

elsif ( $FORM::stage =~ "modify" ) {

	#debug("in modify stage");

	# Modification of a file has been requested.

	# check if the user is logged in...

	my $session = CGI::Session->load() or die CGI::Session->errstr();

	if ( $session->is_empty ) {

		# no session found ... redirect to login page template

		$$templateVars{'message'} = 'You must login to modify your dataset.';

		$template->process( $templates->{'login'}, $templateVars );

	}

	else {

		# Show the form will all the values filled in.

		my @sortedSites;

		foreach my $site ( sort @sitelist ) {

			push( @sortedSites, $site );

		}

		$$templateVars{'siteList'} = \@sortedSites;

		$$templateVars{'section'}  = "Modification Form";

		my ( $foundScope, $id, $rev ) = split( /\./, $FORM::docid );

		if ( !$rev ) {

			my $metacat = Metacat->new($metacatUrl);

			my $lastRev = $metacat->getLastRevision($FORM::docid);

			$$templateVars{'docid'} = $FORM::docid . "." . $lastRev;

		}

		else {

			$$templateVars{'docid'} = $FORM::docid;

		}

		modifyData();

	}

	exit();

}

elsif ( $FORM::stage =~ "delete_confirm" ) {

	# Result from deleteData form.

	if ( $FORM::deleteData =~ "Delete document" ) {

		# delete Data

		deleteData(1);

		exit();

	}

	else {

		$$templateVars{'status'}   = "Cancel";

		$$templateVars{'function'} = "cancel";

		$template->process( $templates->{'response'}, $templateVars );

		exit();

	}

}

elsif ( $FORM::stage =~ "delete" ) {

	# Deletion of a file has been requested.

	# Ask for username and password using deleteDataForm

	$$templateVars{'docid'} = $FORM::docid;

	$template->process( $templates->{'deleteData'}, $templateVars );

	exit();

}

elsif ( $FORM::stage !~ "confirmed" ) {

	# None of the stages have been reached and data is not being confirmed.

	# check if the user is logged in...

	my $session = CGI::Session->load() or die CGI::Session->errstr();

	if ( $session->is_empty ) {

		# no session found ... redirect to login page template

		$$templateVars{'showInstructions'} = 'true';

		$$templateVars{'message'} = 'You must login to register your dataset.';

		$template->process( $templates->{'login'}, $templateVars );

	}

	else {

		# Hence, send back entry form for entry of data.

		debug("Sending form");

		my @sortedSites;

		foreach my $site ( sort @sitelist ) {

			push( @sortedSites, $site );

		}

		if ( $skinName eq 'nceas' ) {

			my $projects = getProjectList($properties);

			$$templateVars{'projects'} = $projects;

			$$templateVars{'wg'}       = \@FORM::wg;

		}

		$$templateVars{'modules'}   = $modules;

		$$templateVars{'required'}  = $required;

		$$templateVars{'templates'} = $templates;

		$$templateVars{'show'}      = $show;

		$$templateVars{'site'}      = $config->{'site'};

		$$templateVars{'siteList'} = \@sortedSites;

		$$templateVars{'section'}  = "Entry Form";

		$$templateVars{'docid'}    = "";

		debug("Sending form: ready to process template");

		$template->process( $templates->{'entry'}, $templateVars );

		debug("Sending form: template processed");

	}

	exit();

}

# Confirm stage has been reached. Enter the data into metacat.

# Initialize some global vars

my $latDeg1      = "";

my $latMin1      = "";

my $latSec1      = "";

my $hemisphLat1  = "";

my $longDeg1     = "";

my $longMin1     = "";

my $longSec1     = "";

my $hemisphLong1 = "";

my $latDeg2      = "";

my $latMin2      = "";

my $latSec2      = "";

my $hemisphLat2  = "";

my $longDeg2     = "";

my $longMin2     = "";

my $longSec2     = "";

my $hemisphLong2 = "";

my $modUsername  = "";

my $modPassword  = "";

# validate the input form parameters

my $invalidParams;

if ( !$error ) {

	$invalidParams = validateParameters(1);

	if ( scalar(@$invalidParams) ) {

		$$templateVars{'status'}        = 'failure';

		$$templateVars{'invalidParams'} = $invalidParams;

		$error                          = 1;

	}

}

my $docid;

# Create a metacat object

my $metacat = Metacat->new($metacatUrl);

if ( !$error ) {

	# Login to metacat

	my ( $username, $password ) = getCredentials();

	my $response = $metacat->login( $username, $password );

	my $errorMessage = "";

	# Parameters have been validated and Create the XML document

	my $xmldoc = createXMLDocument();

	my $xmldocWithDocID = $xmldoc;

	my $errorMessage    = "";

	if ( !$response ) {

		debug("No response from Metacat");

		push( @errorMessages, $metacat->getMessage() );

		push( @errorMessages, "Failed during login.\n" );

		$$templateVars{'status'}        = 'login_failure';

		$$templateVars{'errorMessages'} = \@errorMessages;

		$$templateVars{'docid'}         = $docid;

		$$templateVars{'cfg'}           = $skinName;

		$$templateVars{'function'}      = "submitted";

		$$templateVars{'section'}       = "Submission Status";

		$template->process( $templates->{'response'}, $templateVars );

		exit();

	}

	else {

		if ( $config->{'adminIsDocOwner'} eq 'true' ) {

			debug("adminIsDocOwner is set.");

			$response = $metacat->login( $adminUsername, $adminPassword );

			if ( !$response ) {

				push( @errorMessages, $metacat->getMessage() );

				push( @errorMessages, "Failed during login for admin.\n" );

				$$templateVars{'status'}        = 'login_failure';

				$$templateVars{'errorMessages'} = \@errorMessages;

				$$templateVars{'docid'}         = $docid;

				$$templateVars{'cfg'}           = $skinName;

				$$templateVars{'function'}      = "submitted";

				$$templateVars{'section'}       = "Submission Status";

				$template->process( $templates->{'response'}, $templateVars );

				exit();

			}

		}

		debug("A");

		if ( $FORM::docid eq "" ) {

			debug("B1");

			# document is being inserted

			my $docStatus = "INCOMPLETE";

			while ($docStatus eq "INCOMPLETE") {

                #Create the docid

                $docid = newDocid($config->{'scope'}, $metacat);

                $xmldocWithDocID =~ s/docid/$docid/;

                debugDoc($xmldocWithDocID);

                $docStatus = insertMetadata( $xmldocWithDocID, $docid );

                debug("B2");

			}

            debug("B3");

            if ( $docStatus ne "SUCCESS" ) {

                debug("NO SUCCESS");

                debug("Message is: $docStatus");

                push( @errorMessages, $docStatus );

            }

            else{

                deleteRemovedData();

            }

		}

		else {

			debug("M1");

			# document is being modified

			$docid = incrementRevision($FORM::docid);

			$xmldoc =~ s/docid/$docid/;

			debugDoc($xmldoc);

			my $response = $metacat->update( $docid, $xmldoc );

			if ( !$response ) {

				push( @errorMessages, $metacat->getMessage() );

				push( @errorMessages, "Failed while updating.\n" );

			}

			debug("M2, $docid");

			if ( scalar(@errorMessages) ) {

				debug("Errors defined in modify.");

				$$templateVars{'docid'} = $FORM::docid;

				copyFormToTemplateVars();

				$$templateVars{'status'}        = 'failure';

				$$templateVars{'errorMessages'} = \@errorMessages;

				$error                          = 1;

			}

			else {

				deleteRemovedData();

				$$templateVars{'docid'} = $docid;

				$$templateVars{'cfg'}   = $skinName;

			}

			# Create our HTML response and send it back

			$$templateVars{'function'} = "modified";

			$$templateVars{'section'}  = "Modification Status";

			$template->process( $templates->{'response'}, $templateVars );

			# send a notification email to the moderator

			if ( hasContent($FORM::cfg) && $FORM::cfg eq 'esa' ) {

				my $title               = "";

				my $contactEmailAddress = "";

				my $contactName         = "";

				my $parser              = XML::LibXML->new();

				my $parsedDoc           = $parser->parse_string($xmldoc);

				$FORM::function = 'modified';

				my $findNodes = $parsedDoc->findnodes('//dataset/title');

				if ( $findNodes->size() > 0 ) {

					# found title

					my $node = '';

					foreach $node ( $findNodes->get_nodelist ) {

						$title = findValue( $node, '../title' );

					}

				}

				$findNodes = $parsedDoc->findnodes('//dataset/contact');

				if ( $findNodes->size() > 0 ) {

					# found contact email address

					my $node = '';

					foreach $node ( $findNodes->get_nodelist ) {

						my $surName =

						  findValue( $node, 'individualName/surName' );

						my $givenName =

						  findValue( $node, 'individualName/givenName' );

						my $organizationName =

						  findValue( $node, 'organizationName' );

						if ( $surName ne '' ) {

							$contactName = $givenName . ' ' . $surName;

						}

						else {

							$contactName = $organizationName;

						}

					}

				}

				$FORM::docid = $docid;

				modSendNotification( $title, $contactEmailAddress, $contactName,

					"Document $docid modification review pending" );

			}

			exit();

		}

	}

	if ( hasContent($FORM::cfg) && $FORM::cfg eq 'esa' ) {

		my $title               = "";

		my $contactEmailAddress = "";

		my $contactName         = "";

		my $parser              = XML::LibXML->new();

		my $parsedDoc           = $parser->parse_string($xmldoc);

		my $findNodes = $parsedDoc->findnodes('//dataset/title');

		if ( $findNodes->size() > 0 ) {

			# found title

			my $node = '';

			foreach $node ( $findNodes->get_nodelist ) {

				$title = findValue( $node, '../title' );

			}

		}

		$findNodes = $parsedDoc->findnodes('//dataset/contact');

		if ( $findNodes->size() > 0 ) {

			# found contact email address

			my $node = '';

			foreach $node ( $findNodes->get_nodelist ) {

				$contactEmailAddress = findValue( $node, 'electronicMailAddress' );

				my $surName   = findValue( $node, 'individualName/surName' );

				my $givenName = findValue( $node, 'individualName/givenName' );

				my $organizationName = findValue( $node, 'organizationName' );

				if ( $surName ne '' ) {

					$contactName = $givenName . ' ' . $surName;

				}

				else {

					$contactName = $organizationName;

				}

			}

		}

		$FORM::docid = $docid;

		modSendNotification( $title, $contactEmailAddress, $contactName,

			"Document $docid review pending" );

	}

}

debug("C");

if ( scalar(@errorMessages) ) {

	debug("ErrorMessages defined.");

	$$templateVars{'docid'} = $FORM::docid;

	copyFormToTemplateVars();

	$$templateVars{'status'}        = 'failure';

	$$templateVars{'errorMessages'} = \@errorMessages;

	$error                          = 1;

}

else {

	$$templateVars{'docid'} = $docid;

	$$templateVars{'cfg'}   = $skinName;

	# delete the remaining file objects from disk

	for ( my $fileNum = 0 ; $fileNum <= $FORM::upCount ; $fileNum++ ) {

		my $fn = 'uploadname_' . $fileNum;

		if ( hasContent( param($fn) ) ) {

			deleteFile( param($fn) );

		}

	}

}

# Create our HTML response and send it back

$$templateVars{'function'} = "submitted";

$$templateVars{'section'}  = "Submission Status";

$template->process( $templates->{'response'}, $templateVars );

exit();

################################################################################

# Subroutine for inserting a document to metacat

#

################################################################################

sub insertMetadata {

	my $xmldoc = shift;

	my $docid  = shift;

	debug("Trying to insert the following document");

	my $docStatus = "SUCCESS";

	debug("Starting insert of $docid (D1)");

	my $response = $metacat->insert( $docid, $xmldoc );

	if ( !$response ) {

		debug("Response gotten (D2)");

		my $errormsg = $metacat->getMessage();

		debug( "Error is (D3): " . $errormsg );

		if ( $errormsg =~ /is already in use/ ) {

			$docStatus = "INCOMPLETE";

		}

		elsif ( $errormsg =~ /<login>/ ) {

			$docStatus = "SUCCESS";

		}

		else {

			$docStatus = $errormsg;

		}

	}

	debug("Ending insert (D4)");

	return $docStatus;

}

################################################################################

#

# Subroutine for generating a new accession number

#  Note: this is not threadsafe, assumes only one running process at a time

#  Also: need to check metacat for max id # used in this scope already

################################################################################

sub newAccessionNumber {

	my $scope    = shift;

	my $metacat  = shift;

	my $errormsg = 0;

	my $docid = $metacat->getLastId($scope);

	if ( !$docid ) {

		$docid = "$scope.1.1";

		debug( "Error in newAccessionNumber: " . $metacat->getMessage() );

	}

	else {

		my ( $foundScope, $id, $rev ) = split( /\./, $docid );

		$id++;

		$docid = "$scope.$id.1";

	}

	debug("Metcat handed us a new docid: $docid");

	return $docid;

}

################################################################################

#

# Subroutine for generating a new docid

# Checks a local file for the max id # in use for this scope. After several tries,

# checks metacat using newAccessionNumber

################################################################################

sub newDocid {

    my $scope   = shift;

    my $metacat = shift;

    my $getFromMetacat  = shift;

    my $scopeFound = 0;

    #Lock a local file while we are creating a new docid

    my $lockFilePath = "docids.lock";

    open my $lock, '>', $lockFilePath;

    flock($lock, LOCK_EX);

    my $lastdocid = newAccessionNumber($scope, $metacat);

    #Extract the docid number from the docid

    my @line = split(/\./, $lastdocid);

    my $num = $line[1];

    my $docidsFilePath    = $tempDir."/docids.txt";

    my $docidsFilePathNew = $tempDir."/docids.txt.new";

    #Open/create a local file while we are creating a new docid

    open my $docidsFile,  '+<',  $docidsFilePath;

    open my $docidsNewFile, '>', $docidsFilePathNew;

    #Read each docid scope,num in the file

    while( <$docidsFile> ) {

        my @line = split /,/;

        my $currentScope = $line[0];

        if($currentScope eq $scope){

            my $docidNum = $line[1] + 1;

            if($num > $docidNum){

              $docid = "$scope.$num.1";

              print $docidsNewFile "$scope,$num \n";

            }

            else{

              $docid = "$scope.$docidNum.1";

              print $docidsNewFile "$scope,$docidNum \n";

            }

            $scopeFound = 1;

        }

        else{

            print $docidsNewFile $_;

        }

    }

    #If this scope is not in the local docid store then add it

    if(!$scopeFound){

        #Add to the local file

        print $docidsNewFile "$scope,$num \n";

    }

    #Close the file and replace the old docids file with this new one

    close $docidsNewFile;

    close $docidsFile;

    move($docidsFilePathNew, $docidsFilePath);

    close $lock;

    return $docid;

}

sub incrementRevision {

	my $initDocid = shift;

	my $docid     = '';

	if ( !$initDocid ) {

		debug("No docid entered.");

	}

	else {

		my ( $scope, $id, $rev ) = split( /\./, $initDocid );

		$rev++;

		$docid = "$scope.$id.$rev";

	}

	return $docid;

}

################################################################################

#

# Validate the parameters to make sure that required params are provided

#

################################################################################

sub validateParameters {

	my $chkUser = shift;

	my @invalidParams;

	push( @invalidParams, "Name of the Project is not selected in the form." )

	  if ( scalar(@FORM::wg) == 0 && $required->{'wgList'} eq 'true' );

	push( @invalidParams, "First name of person entering the form is missing." )

	  unless hasContent($FORM::providerGivenName);

	push( @invalidParams, "Last name of person entering the form is missing." )

	  unless hasContent($FORM::providerSurName);

	push( @invalidParams, "Dataset title is missing." )

	  unless hasContent($FORM::title);

	push( @invalidParams, ucfirst( $config->{'site'} ) . " name is missing." )

	  unless ( ( hasContent($FORM::site) && !( $FORM::site =~ /^Select/ ) )

		|| $skinName eq "nceas" );

	push( @invalidParams, "First name of principal data set owner is missing." )

	  unless hasContent($FORM::origNamefirst0);

	push( @invalidParams, "Last name of principal data set owner is missing." )

	  unless hasContent($FORM::origNamelast0);

	push( @invalidParams, "Dataset abstract is missing." )

	  unless hasContent($FORM::abstract);

	if ( $modules->{'temporal'} eq 'true' ) {

		push( @invalidParams, "Year of start date is missing." )

		  unless ( hasContent($FORM::beginningYear)

			|| $required->{'temporal'} ne 'true' );

		push( @invalidParams,

"Year of stop date has been specified but year of start date is missing."

		  )

		  if ( ( !hasContent($FORM::beginningYear) )

			&& hasContent($FORM::endingYear) );

	}

	push( @invalidParams, "Geographic description is missing." )

	  unless ( hasContent($FORM::geogdesc)

		|| $required->{'spatial'} ne 'true' );

	if ( $FORM::beginningMonth eq "MM" ) {

		$FORM::beginningMonth = "";

	}

	if ( $FORM::beginningDay eq "DD" ) {

		$FORM::beginningDay = "";

	}

	if ( $FORM::endingMonth eq "MM" ) {

		$FORM::endingMonth = "";

	}

	if ( $FORM::endingDay eq "DD" ) {

		$FORM::endingDay = "";

	}

	if ( hasContent($FORM::beginningYear)

		&& !( $FORM::beginningYear =~ /[0-9]{4}/ ) )

	{

		push( @invalidParams, "Invalid year of start date specified." );

	}

	if ( hasContent($FORM::endingYear) && !( $FORM::endingYear =~ /[0-9]{4}/ ) )

	{

		push( @invalidParams, "Invalid year of stop date specified." );

	}

	# If the "use site" coord. box is checked and if the site is in

	# the longitude hash ...  && ($siteLatDMS{$FORM::site})

	if ( $modules->{'spatial'} eq 'true' ) {

		if ( ($FORM::useSiteCoord) && ( $siteLatDMS{$FORM::site} ) ) {

			$latDeg1      = $siteLatDMS{$FORM::site}[0];

			$latMin1      = $siteLatDMS{$FORM::site}[1];

			$latSec1      = $siteLatDMS{$FORM::site}[2];

			$hemisphLat1  = $siteLatDMS{$FORM::site}[3];

			$longDeg1     = $siteLongDMS{$FORM::site}[0];

			$longMin1     = $siteLongDMS{$FORM::site}[1];

			$longSec1     = $siteLongDMS{$FORM::site}[2];

			$hemisphLong1 = $siteLongDMS{$FORM::site}[3];

		}

		else {

			$latDeg1      = $FORM::latDeg1;

			$latMin1      = $FORM::latMin1;

			$latSec1      = $FORM::latSec1;

			$hemisphLat1  = $FORM::hemisphLat1;

			$longDeg1     = $FORM::longDeg1;

			$longMin1     = $FORM::longMin1;

			$longSec1     = $FORM::longSec1;

			$hemisphLong1 = $FORM::hemisphLong1;

		}

		if ( $latDeg1 > 90 || $latDeg1 < 0 ) {

			push( @invalidParams, "Invalid first latitude degrees specified." );

		}

		if ( $latMin1 > 59 || $latMin1 < 0 ) {

			push( @invalidParams, "Invalid first latitude minutes specified." );

		}

		if ( $latSec1 > 59 || $latSec1 < 0 ) {

			push( @invalidParams, "Invalid first latitude seconds specified." );

		}

		if ( $longDeg1 > 180 || $longDeg1 < 0 ) {

			push( @invalidParams,

				"Invalid first longitude degrees specified." );

		}

		if ( $longMin1 > 59 || $longMin1 < 0 ) {

			push( @invalidParams,

				"Invalid first longitude minutes specified." );

		}

		if ( $longSec1 > 59 || $longSec1 < 0 ) {

			push( @invalidParams,

				"Invalid first longitude seconds specified." );

		}

		if ( hasContent($FORM::latDeg2)

			&& ( $FORM::latDeg2 > 90 || $FORM::latDeg2 < 0 ) )

		{

			push( @invalidParams,

				"Invalid second latitude degrees specified." );

		}

		if ( hasContent($FORM::latMin2)

			&& ( $FORM::latMin2 > 59 || $FORM::latMin2 < 0 ) )

		{

			push( @invalidParams,

				"Invalid second latitude minutes specified." );

		}

		if ( hasContent($FORM::latSec2)

			&& ( $FORM::latSec2 > 59 || $FORM::latSec2 < 0 ) )

		{

			push( @invalidParams,

				"Invalid second latitude seconds specified." );

		}

		if ( hasContent($FORM::latDeg2)

			&& ( $FORM::longDeg2 > 180 || $FORM::longDeg2 < 0 ) )

		{

			push( @invalidParams,

				"Invalid second longitude degrees specified." );

		}

		if ( hasContent($FORM::latMin2)

			&& ( $FORM::longMin2 > 59 || $FORM::longMin2 < 0 ) )

		{

			push( @invalidParams,

				"Invalid second longitude minutes specified." );

		}

		if ( hasContent($FORM::latSec2)

			&& ( $FORM::longSec2 > 59 || $FORM::longSec2 < 0 ) )

		{

			push( @invalidParams,

				"Invalid second longitude seconds specified." );

		}

	}

	# Check if latDeg1 and longDeg1 has values if useSiteCoord is used.

	# This check is required because some of the sites dont have lat

	# and long mentioned in the config file.

	if ( $modules->{'spatial'} eq 'true' && $required->{'spatial'} eq 'true' ) {

		if ($FORM::useSiteCoord) {

			push( @invalidParams,

"The Data Registry doesn't have latitude and longitude information for the site that you chose. Please go back and enter the spatial information."

			) unless ( hasContent($latDeg1) && hasContent($longDeg1) );

		}

		else {

			push( @invalidParams, "Latitude degrees are missing." )

			  unless ( hasContent($latDeg1)

				|| $required->{'spatial'} ne 'true' );

			push( @invalidParams, "Longitude degrees are missing." )

			  unless ( hasContent($longDeg1)

				|| $required->{'spatial'} ne 'true' );

		}

		push( @invalidParams,

"You must provide a geographic description if you provide latitude and longitude information."

		  )

		  if ( ( hasContent($latDeg1) || ( hasContent($longDeg1) ) )

			&& ( !hasContent($FORM::geogdesc) ) );

	}

	if ( $modules->{'method'} eq 'true' ) {

		push( @invalidParams,

"You must provide a method description if you provide a method title."

		  )

		  if (

			hasContent($FORM::methodTitle)

			&& (  !( scalar(@FORM::methodPara) > 0 )

				|| ( !hasContent( $FORM::methodPara[0] ) ) )

		  );

		push( @invalidParams,

"You must provide a method description if you provide an extent of study description."

		  )

		  if (

			hasContent($FORM::studyExtentDescription)

			&& (  !( scalar(@FORM::methodPara) > 0 )

				|| ( !hasContent( $FORM::methodPara[0] ) ) )

		  );

		push( @invalidParams,

"You must provide both an extent of study description and a sampling description, or neither."

		  )

		  if (

			(

				hasContent($FORM::studyExtentDescription)

				&& !hasContent($FORM::samplingDescription)

			)

			|| (  !hasContent($FORM::studyExtentDescription)

				&& hasContent($FORM::samplingDescription) )

		  );

	}

	if ( $modules->{'upload'} eq 'true' ) {

		for ( my $upNum = 0 ; $upNum <= $FORM::upCount ; $upNum++ ) {

			my $upn = "upload_$upNum";

			if ( hasContent( param($upn) )

				&& !grep { $_ eq ("uploadname_$upNum") } @FORM::deletefile )

			{

				push( @invalidParams,

					"Must select a permission for file "

					  . param("uploadname_$upNum") )

				  if ( !hasContent( param("uploadperm_$upNum") ) );

			}

		}

	}

	push( @invalidParams, "First name of data set contact is missing." )

	  unless ( hasContent($FORM::origNamefirstContact)

		|| $FORM::useOrigAddress );

	push( @invalidParams, "Last name of data set contact is missing." )

	  unless ( hasContent($FORM::origNamelastContact)

		|| $FORM::useOrigAddress );

	if ( $required->{'contactEmailAddress'} eq 'true' ) {

		if ($FORM::useOrigAddress) {

			push( @invalidParams,

"Email address of data set owner is missing. This is required as it will be used as contact email address as specified by you."

			) unless ( hasContent($FORM::origEmail) );

		}

		else {

			push( @invalidParams,

				"Email address of data set contact is missing." )

			  unless ( hasContent($FORM::origEmailContact) );

		}

	}

	# check required distribution elements

	push( @invalidParams, "Data medium is required." )

	  unless ( hasContent($FORM::dataMedium) );

	if ( $FORM::dataMedium eq 'other' ) {

		push( @invalidParams,

			"Must enter custom data medium when 'other' is selected." )

		  unless ( hasContent($FORM::dataMediumOther) );

	}

	push( @invalidParams, "Usage rights are required." )

	  unless ( hasContent($FORM::useConstraints) );

	if ( $FORM::useConstraints eq 'other' ) {

		push( @invalidParams,

			"Must enter custom usage rights when 'other' is selected." )

		  unless ( hasContent($FORM::useConstraintsOther) );

	}

	return \@invalidParams;

}

################################################################################

#

# utility function to determine if a paramter is defined and not an empty string

#

################################################################################

sub hasContent {

	my $param = shift;

	my $paramHasContent;

	if ( !defined($param) || $param eq '' ) {

		$paramHasContent = 0;

	}

	else {

		$paramHasContent = 1;

	}

	return $paramHasContent;

}

################################################################################

#

# Subroutine for replacing characters not recognizable by XML and otherwise.

#

################################################################################

sub normalize {

	my $val = shift;

	$val =~ s/&/&/g;

	$val =~ s/</&lt;/g;

	$val =~ s/>/>/g;

	$val =~ s/\"/"/g;

	$val =~ s/%/%/g;

	my $returnVal = "";

	foreach ( split( //, $val ) ) {

		my $var = unpack "C*", $_;

		if ( $var < 128 && $var > 31 ) {

			$returnVal = $returnVal . $_;

		}

		elsif ( $var < 32 ) {

			if ( $var == 10 ) {

				$returnVal = $returnVal . $_;

			}

			if ( $var == 13 ) {

				$returnVal = $returnVal . $_;

			}

			if ( $var == 9 ) {

				$returnVal = $returnVal . $_;

			}

		}

		else {

			$returnVal = $returnVal . $_;

		}

	}

	return $returnVal;

}

################################################################################

#

# Subroutine for replacing characters not recognizable by XML and otherwise

# except for ", > amd <.

#

################################################################################

sub delNormalize {

	my $val = shift;

	$val =~ s/&/&/g;

	$val =~ s/%/%/g;

	my $returnVal = "";

	foreach ( split( //, $val ) ) {

		my $var = unpack "C*", $_;

		if ( $var < 128 && $var > 31 ) {

			$returnVal = $returnVal . $_;

		}

		elsif ( $var < 32 ) {

			if ( $var == 10 ) {

				$returnVal = $returnVal . $_;

			}

			if ( $var == 13 ) {

				$returnVal = $returnVal . $_;

			}

			if ( $var == 9 ) {

				$returnVal = $returnVal . $_;

			}

		}

		else {

			$returnVal = $returnVal . "&#" . $var . ";";

		}

	}

	$returnVal =~ s/&/%26/g;

	return $returnVal;

}

################################################################################

#

# Subroutine for replacing characters that might create problem in HTML.

# Specifically written for " being used in any text field. This creates a

# problem in confirmData template, when you specify input name value pair

# with value having a " in it.

#

################################################################################

sub normalizeCD {

	my $val = shift;

	$val =~ s/\"/"/g;

	return $val;

}

################################################################################

#

# Upload new file objects into Metacat, if they're present and valid.

#

################################################################################

sub allFileData {

	my %uploadedFiles = ();

	my $fileInfo;

	my $docid;

	for ( my $fileNum = 0 ; $fileNum <= $FORM::upCount ; $fileNum++ ) {

		my $fn = 'upload_' . $fileNum;

		if ( hasContent( param($fn) ) ) {

			# ignore data which is scheduled for deletion

			if ( grep { $_ eq ("uploadname_$fileNum") } @FORM::deletefile ) {

				debug(

"Not generating metadata for file scheduled for deletion: $fn"

				);

			}

			else {

				debug("Retrieving metadata for file: $fn");

				( $docid, $fileInfo ) = fileMetadata($fileNum);

				$uploadedFiles{$docid} = $fileInfo;

			}

		}

	}

	return %uploadedFiles;

}

sub fileMetadata {

	my $fileNum     = shift;

	my $fileHash    = param("upload_$fileNum");

	my $fileName    = param("uploadname_$fileNum");

	my $contentType = param("uploadtype_$fileNum");

	my $filePerm    = param("uploadperm_$fileNum");

	my $docid;

	my $outFile;

	my $cleanName = $fileName;

	# process an _existing_ data file, which is already within Metacat.

	if ( $fileHash =~ /ondisk/ ) {

		( $docid, $fileHash ) = datafileInfo($fileHash);

		$outFile = $dataDir . "/" . $docid;

	}

	else {

		# normalize input filenames; Windows filenames include full paths

		$cleanName =~ s/.*[\/\\](.*)/$1/;

		$outFile = $tempDir . "/" . $cleanName;        

	}

	debug("Reading file from disk: $outFile");

	my $fileSize = stat($outFile)->size;

	if ( $fileSize == 0 ) {

		push( @errorMessages, "file $fileName is zero bytes!" );

		debug("File $fileName is zero bytes!");

	}

	# Now the file is on disk, send the object to Metacat

	my $session = CGI::Session->load();

	if ( $session->is_empty ) {

		push( @errorMessages, "Must be logged in to upload files." );

		debug("Not logged in, cannot upload files.");

		return 0;

	}

	# remove the uniqueness of the filename

	# 'tempXXXXX'

	$cleanName = substr($cleanName, 9);

	if ( !$docid ) {

        my $uploadStatus = shift;

        while(!$uploadStatus){

            $docid = newDocid($config->{'scope'}, $metacat);

            $uploadStatus = uploadData( $outFile, $docid, $cleanName );

            if ( !$uploadStatus ) {

                debug("Uploading the data failed.");

                push( @errorMessages, "Data file $cleanName failed to upload");

            }

        }

	}

	my $entityid  = $fileHash . "001";

	my $distribid = $fileHash . "002";

	my $uploadUrl = 'ecogrid://knb/' . $docid;

	# TODO:  should match the object promotion path, so that an

	#        Excel upload results in 'dataTable' in this field

	my $entityType = 'Other';

	my %dataInfo = (

		'docid'       => $docid,

		'entityid'    => $entityid,

		'distribid'   => $distribid,

		'fileName'    => $cleanName,

		'fileSize'    => $fileSize,

		'fileHash'    => $fileHash,

		'filePerm'    => $filePerm,

		'contentType' => $contentType,

		'url'         => $uploadUrl,

		'entityType'  => $entityType,

	);

	return ( $docid, \%dataInfo );

}

sub datafileInfo {

	my $finfo = shift;

	$finfo =~ s/ondisk://g;

	return my ( $docid, $fileHash ) = split( ":", $finfo );

}

sub processFile {

	my $fileName = shift;

	# test that we actually got a file

	if ( !$fileName || cgi_error() ) {

		debug( "Error receiving file " . cgi_error() );

	}

	# write file to disk, get SHA1 hash and size

	my ( $outFile, $fileHash ) = writeFile($fileName);

	debug( "processed file to temp directory:  $outFile" );

	my $fileSize = stat($outFile)->size;

	if ( $fileSize == 0 ) {

		push( @errorMessages, "file $fileName is zero bytes!" );

		debug("File $fileName is zero bytes!");

	}

	# file is in Metacat, generate the pertinent EML elements

	my $contentType = uploadInfo($fileName)->{'Content-Type'};

	# occasionally CGI.pm doesn't get the file info.  In this case,

	# use a default MIME type of text/plain.  Seems fixed in the newer CGI.pm:

	# http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=313141

	if ( !$contentType ) {

		$contentType = 'text/plain';

	}

	my %dataInfo = (

		'fileName'    => $outFile,

		'fileHash'    => $fileHash,

		'contentType' => $contentType,

	);

	return \%dataInfo;

}

sub writeFile {

	my $fileName = shift;

	my $fileData;

	my $length = 0;

	my $buffer;

	my $cleanName = $fileName;

	# normalize input filenames; Windows filenames include full paths

	$cleanName =~ s/.*[\/\\](.*)/$1/;

	while ( my $bytesRead = read( $fileName, $buffer, 4096 ) ) {

		$fileData .= $buffer;

		$length += $bytesRead;

	}

	# create SHA1 sum to store file hash

	my $ctx = Digest::SHA1->new;

	$ctx->add($fileData);

	my $digest = $ctx->hexdigest;

	# use tempfile for writing

	my $tmp = File::Temp->new( 

						TEMPLATE => 'tempXXXXX',

                        DIR => $tempDir,

                        SUFFIX => $cleanName, 

                        UNLINK => 0);

	my $outputName = $tmp->filename();

	#open( OUT, ">$outputName" ) or die "Could not open: $!";

	print $tmp $fileData;

	close($tmp);

	debug("Writing output, result is: $outputName");

	return ( $outputName, $digest );

}

sub deleteRemovedData {

# if we have any associated datafiles which are scheduled for deletion, remove them now

	for ( my $delNum = 0 ; $delNum <= $FORM::delCount ; $delNum++ ) {

	  # need to look up the actual upload number, which is contained in the name

		my $upNum = param("deletefile_$delNum");

		$upNum =~ s/uploadname_//;

		my $upn = param("upload_$upNum");

		if ( hasContent($upn) ) {

			debug("Deleting upload_$upNum, $upn");

			if ( grep { $_ eq ("uploadname_$upNum") } @FORM::deletefile ) {

				if ( param("upload_$upNum") =~ /ondisk/ ) {

					debug(

						"got a file which is ondisk, proceeding with deletion");

					deleteFileData( param("upload_$upNum") );

				}

				else {

					debug(

"got an old reference, not yet in EML, remove from tempdir"

					);

					deleteFile( param("uploadname_$upNum") );

				}

			}

			else {

				debug("Name didn't match in deletefile list");

			}

		}

	}

}

sub deleteFile {

	my $input    = shift;

	#my $fileName = $tempDir . "/" . $input;

	my $fileName = $input;

	if ( -e $fileName ) {

		unlink $fileName

		  or debug("Failed to delete file $fileName.");

	}

	else {

		debug("Unable to find file $fileName");

	}

	if ( !-e $fileName ) {

		debug("Successfully deleted $fileName");

	}

}

sub deleteFileData {

	my $input = shift;

	my ( $docid, $fileHash ) = datafileInfo($input);

	my $metacat = Metacat->new($metacatUrl);

	my ( $username, $password ) = getCredentials();

	my $response = $metacat->login( $username, $password );

	if ( !$response ) {

		my $msg = $metacat->getMessage();

		push( @errorMessages,

			"Failed to login with credentials for `$username`. Error was $msg"

		);

		debug(

"Failed to login with given credentials for username $username, Error is: $msg"