#!/usr/bin/perl -w
#===================================================
# Provides Web access to a PDS catalog and data stored 
# on hard disks or in a jukebox
#
# Written by: Todd King, 2000-2002
# Release: 2.4
#===================================================
use strict;
use CGI qw(:all);
use CGI::Carp qw(fatalsToBrowser);
use Text::ParseWords;
use String::Strip;
use String::Escape qw(unquote);
use Fcntl qw(:flock);
use LWP::UserAgent;
use Sys::Hostname;

# Security features
$CGI::DISABLE_UPLOADS = 1;      # no uploads
$CGI::POST_MAX = 5 * 1024;      # bytes

my $semaphoreFile = "/tmp/juke.sem";

# Compares two items using multiple keys.
# Returns -1 if item1 < item2, 0 if the same and 1 if item1 > item2
# CompareItem(item1, item2, keylist)
sub CompareItem {
   my $item1 = shift;
   my $item2 = shift;
   my $keyList = shift;
   my $key;
   my $n;
   
	foreach $key (@$keyList) {
	   $n = @$item1[$key] cmp @$item2[$key];
	   if($n != 0) { return ($n); }
	}
	
	return 0;   
}

# Create a list of unique entries based on multiple keys
# UniqueList(array, keyList) 
sub UniqueList {
   my $list = shift;
   my $keyList = shift;
	my @sorted;
	my @unique;
	my $item1;
	my $item2;
	my $count;
	my $i;

	@sorted = SortList($list, $keyList);
	
	$count = scalar(@sorted);
	if($count > 0) {
		$item1 = $sorted[0];
		push(@unique, $item1);
	}
	for($i = 1; $i < $count; $i++) {
		$item2 = $sorted[$i];
		if(CompareItem($item1, $item2, $keyList) != 0) {
			$item1 = $item2;
			push(@unique, $item1);
		}	
	}
		
	return @unique;
}

# Sort a list of arrays based on multiple keys
# SortList(array, keyList) 
sub SortList {
   my $list = shift;
	my $keyList = shift;
	my @sorted;
	my $item1;
	my	$item2;
	my $temp;
	my	$count;
	my	$i;
	my $j;

   # Make copy of list
	foreach $item1 (@$list) {	
		push(@sorted, $item1);
	}
		
	# use a bubble sort to sort the list. The function CompareItem() performs the comparision.
	$count = scalar(@sorted);
	for($i = 0; $i < $count; $i++) {
	   $item1 = $sorted[$i];
	   for($j = $i + 1; $j < $count; $j++) {
	      $item2 = $sorted[$j];
	      if(CompareItem($item1, $item2, $keyList) > 0) {	# Switch positions of items
	         $temp = $item1;
	         $item1 = $item2;
	         $item2 = $temp;
	         $sorted[$i] = $item1;
	         $sorted[$j] = $item2;
	      }
	   }
	}
	
	return @sorted;
}

# Filter a list of volume arrays. Return the matching subset
# FilterList(array, filterList, key) 
sub FilterList {
   my $list = shift;
	my $filterList = shift;
	my $key = shift;

	my $item;
	my $filter;
	my @filtered;
	my $buffer;
	
	if(scalar(@$filterList) == 0) { # If no filter return all
		foreach $item (@$list) {
			push @filtered, $item;
		}
	} else {
		foreach $item (@$list) {
		   foreach $filter (@$filterList) {
		   	if(@$item[$key]=~m/^$filter/i || @$item[$key]=~m/\*/i) {
		      		push @filtered, $item;
		   	}
		   }
		}
	}
	
	return @filtered;
}

# Exclude items from a list of volume arrays. Return the matching subset
# ExcludeList(array, filterList, key) 
sub ExcludeList {
   my $list = shift;
	my $filterList = shift;
	my $key = shift;

	my $item;
	my $filter;
	my @filtered;
	my $buffer;
	my $add;
	
	if(scalar(@$filterList) == 0) { 
		foreach $item (@$list) {
			push @filtered, $item;
		}
	} else {
		foreach $item (@$list) {
		   $add = 1;
		   foreach $filter (@$filterList) {
		   	if(@$item[$key]=~m/^$filter/i) {
		      	$add = 0;
		      	last;
		   	}
		   }
      	if($add) { push @filtered, $item; }
		}
	}
	
	return @filtered;
}

# Removes any leading or trailing quotes
# Return the altered line.
# RemoveQuote(line)
sub RemoveQuote {
   my $line = shift;
   
   $line =~ s/"//;
   
   return $line;
}

# Count the number of qoutes (") in a line of text
# Return the count.
# QuoteCount(line)
sub QuoteCount {
   my $line = shift;
   
   my @char;
   my $c;
   my $count;
   
   @char = split(//, $line);	# Split into invidual characters
   
   $count = 0;
   foreach $c (@char) {
      if($c eq '"') { $count++; }
   }

	return $count;
}

# Converts a string to proper case. Each word with first letter capitalized
# ProperCase(line)
sub ProperCase {
	my $line = shift;
	my @words;
	my $w;
	my $buffer;
	
	@words = split(' ', $line);
	foreach $w (@words) {
	  if(defined $buffer) { $buffer .= ' '; }
	  $buffer .= "\L\u$w";
	}
	
	return $buffer;
}

# Extract files of a certain type from a list. The matching names
# are sorted and returned in a list.
# ExtractList(path, nameList, type)
sub ExtractList {
	my $path = shift;
	my $arg = shift;
	my @list = @$arg;
	my $type = shift;
	
	my @match;
	my $item;
	
	foreach $item (@list) {
		if($type eq 'd') {
		   if(-d "$path/$item") { push @match, $item; }
		} elsif($type eq 'f') {
		   if(-f "$path/$item") { push @match, $item; }
		}
	}
	@match = sort(@match);     
	
	return @match;
}

# Cleans up the grammer of a description by removing certain leading phrases
# FixupDesc($desc)
sub FixupDesc {
	my $desc = shift;
	
	StripLSpace($desc);
	$desc =~ s/^This volume contains the //;
	$desc =~ s/^This volume contains //;
	$desc =~ s/^This volume //;
	$desc =~ s/^This CD-ROM contains //;
	$desc =~ s/^This CD-ROM is //;
	$desc = "\u$desc";
	
	return $desc;
}
	
# Mount a volume and return the path to the volume
# VolumeMount(options, slot)
sub VolumeMount {
	my $arg = shift;
	my %options = %$arg;
	my $slot = shift;
	
	my $command;
	
	# If $slot is not a number then its a path to the volume
	if(int($slot) == 0) { return $slot; }
	
	# Mount the media in the given slot
	$command = $options{jukeload} . " $slot 1 " . $options{reader1} . " " . $options{mount1};
	system($command);
	sleep(3); # Wait a little while for mount to take place - the continue
	
	# Return the mount point
	return $options{mount1};
}

# Obtain or release excluse use of the jukebox
# JukeLock(lock)
sub JukeLock {
	my $lock = shift;
	
	if($lock) {	# Obtain exclusive use of the jukebox
		open(JUKESEM, ">$semaphoreFile") || die "Cannot create semaphore: $!";
		flock(JUKESEM, LOCK_EX) || die "Local failed: $!";
	} else {	# Release the active lock
		close(JUKESEM);
	}
}

# Translate a word to a phrase
# Translate(word, phraseList)
sub Translate {
	my $word = shift;
	my $phraseList = shift;
	
	my $item;
	my $phrase = $word;
	
	foreach $item (@$phraseList) {
		if($word eq @{$item}[0]) {
			$phrase = @{$item}[1];
			last;
		}
	}
	
	return $phrase;
}
	
# Find a volume in the volume list.
# Return array describing volume
# VolumeFind(volumeList, volume)
sub VolumeFind {
	my $volumeList = shift;
	my $volume = shift;
	
	my $item;

	foreach $item (@$volumeList) {	
		if(@{$item}[1] eq $volume) { return $item; }
	}
	
	return undef;
}
	   
# Print a list of series
# SeriesPage(options, title, filterList, excludeList, volumeList)
sub SeriesPage {
   my $arg = shift;
   my %options = %$arg;
   my $title = shift;
   my $filterList = shift;
   my $excludeList = shift;
   my $volumeList = shift;

	my @body;   
	my @unique;
	my @keyList;
	my @filtered;
	my @finalList;
	my @part;
	
	my $line;
	my $buffer;
	my $temp;
	my $ditdos = $options{ditdos};
	my $series;
	my $first = 1;
	
	# Initialize variables
	if(defined $title) { @body = ("<H2>$title</H2>"); }
	
	# Sort the list on volume name
	# 0 = slot; 1 = volume_id, 2 = volume_series_name, 3 = volume_name, 4 = Description, 5 = Browser
	@filtered = FilterList($volumeList, $filterList, 2);	# key = 2 (VOLUME_ID)
	@finalList = ExcludeList(\@filtered, $excludeList, 2); # key = 2 (VOLUME_ID)
	@keyList = (2);	# Sort on VOLUME_SERIES_NAME
	@unique = UniqueList(\@finalList, \@keyList);	
	$buffer = "";
	# Now write HTML to display list
	push @body, "<TABLE BORDER=0>";
	foreach $line (@unique) {
		$temp = @$line[0];	# Slot
		if($temp=~m/^http:/i) {	# Extract server portion
			@part = split('\?', $temp, 2);
			$ditdos = $part[0];
		} else {	# Use local server
			$ditdos = $options{ditdos};
		}
		$series = @{$line}[2];
		$series =~ s/ /_/g;
		push @body, "<TR><TD><A href=$ditdos?series=$series onClick=\"ShowMessage()\">@{$line}[2]</A></DT></TD>";
		push @body, "</TD></TR>";
	}
	push @body, "<TR><TD>&nbsp;</TD></TR>";
	push @body, "<TR><TD ALIGN=center><A href=$ditdos?series=* onClick=\"ShowMessage()\">All Data Volumes</A></DT></TD>";
	push @body, "</TD></TR>";
	
	if(!$first) { push @body, "</TABLE>"; }
	
	CreatePage(\%options, \@body);
}

# Print a list of volumes
# VolumePage(options, title, url, seriesList, filterList, excludeList, volumeList)
sub VolumePage {
   my $arg = shift;
   my %options = %$arg;
   my $title = shift;
   my $url = shift;
   my $seriesList = shift;
   my $filterList = shift;
   my $excludeList = shift;
   my $volumeList = shift;

	my @body;   
	my @sorted;
	my @keyList;
	my @preFiltered;
	my @filtered;
	my @finalList;
	my @part;
	
	my $line;
	my $buffer;
	my $temp;
	my $ditdos;
	my $first = 1;
	my $style;
	
	# Initialize variables
	
	# Sort the list on volume name
	# 0 = slot; 1 = volume_id, 2 = volume_series_name, 3 = volume_name, 4 = Description, 5 = browser
	@preFiltered = FilterList($volumeList, $seriesList, 2);	# key = 1 (VOLUME_SERIES_NAME)
	@filtered = FilterList(\@preFiltered, $filterList, 1);	# key = 1 (VOLUME_ID)
	@finalList = ExcludeList(\@filtered, $excludeList, 1); # key = 1 (VOLUME_ID)
	if(defined $title) { @keyList = (1); }	# Sort on VOLUME_ID
	else { @keyList = (2, 1); }	# Sort on VOLUME_SERIES_NAME then VOLUME_ID
	@sorted = SortList(\@finalList, \@keyList);	
	$buffer = "";
	
	# Now write HTML to display list
	push @body, "<TABLE WIDTH=100% BORDER=0><TR>";
	if(defined $title) { push @body, "<TD><H2>$title</H2></TD>";
	} else { push @body, "<TD>&nbsp;</TD>"; }
	
	if($options{brief}) { 
		push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=full>";
		push @body, "<IMG border=0 alt=Expand onClick=\"ShowMessage()\" src=$options{expandButton}>";
		push @body, "</A></TD>"; 
		$style = "brief";
	} else { 
		push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=brief>";
		push @body, "<IMG border=0 alt=Brief onClick=\"ShowMessage()\" src=$options{briefButton}>";
		push @body, "</A></TD>"; 
		$style = "full";
	}
	push @body, "</TR></TABLE>";
	
	# Write each volume info
	if(defined $title) { 
		push @body, "<TABLE BORDER=0>"; $first = 0; 
	}
	foreach $line (@sorted) {
		if(!defined $title && $buffer ne @$line[2]) {	# Insert a title
			if(!$first) { push @body, "</TABLE>"; }
			push @body, "<H2>@{$line}[2]</H2>";
			push @body, "<TABLE BORDER=0>";
			$buffer = @$line[2];
			$first = 0;
		}
		$temp = @$line[0];	# Slot
		if($temp=~m/^http:/i) {	# Extract server portion
			@part = split('\?', $temp, 2);
			$ditdos = $part[0];
		} else {	# Use local server
			$ditdos = $options{ditdos};
		}
		
		# Define the browser to use
		push @body, "<TD><A href=\"$ditdos?volume=@{$line}[1]\" onClick=\"ShowMessage()\">@{$line}[1]</A></DT></TD>";
		push @body, "<TD>";
		push @body, "<A HREF=$ditdos?order=@{$line}[1]><img border=0 src=\"$options{orderButton}\" alt=\"Order Volume\"></A>";
		if(stat("$options{errata}/@{$line}[1]")) {
			push @body, "<A HREF=$ditdos?errata=@{$line}[1]><img border=0 src=\"$options{errataButton}\" alt=\"Errata\"></A>";
		}
		if(length(@{$line}[5]) != 0) {	# Detail Browser defined
			push @body, "<A HREF=\"@{$line}[5]\"><img border=0 src=\"$options{detailBrowserButton}\" alt=\"Detail Browse Volume\"></A>";
		}
		if(length(@{$line}[6]) != 0) {	# Map Browser defined
			push @body, "<A HREF=\"@{$line}[6]\"><img border=0 src=\"$options{mapBrowserButton}\" alt=\"Map Browse Volume\"></A>";
		}
		push @body, "</TD></TR>";
  		if($options{brief} == 1) { 
  			push @body, "<TR><TD></TD><TD>@{$line}[3]</TD></TR>"; 
  		} else { 
  			push @body, "<TR><TD></TD><TD>@{$line}[4]</TD></TR>"; 
  		}
	}
   if(!$first) { push @body, "</TABLE>"; }
	
   CreatePage(\%options, \@body);
}

# Print a list of volumes that contain a dataset
# DSVolumePage(options, url, dataset, datasetList, volumeList)
sub DSVolumePage {
   my $arg = shift;
   my %options = %$arg;
   my $url = shift;
   my $dataset = shift;
   my $datasetList = shift;
   my $volumeList = shift;

	my @body;   
	my @sorted;
	my @keyList;
	my @filtered;
	my @finalList;
	my @part;
	
	my $line;
	my $buffer;
	my $temp;
	my $ditdos;
	my $volume;
	
	# Initialize variables
	
	# Sort the list on dataset list
	# 0 = dataset_idt; 1 = volume_id
	@keyList = ();
	push @keyList, $dataset;
	@filtered = FilterList($datasetList, \@keyList, 0);	# key = 1 (DATASET_ID)
	@keyList = (1);	# Volume_ID
	@sorted = SortList(\@filtered, \@keyList);	
	$buffer = "";
	
	# Now write HTML to display list
	push @body, "<TABLE WIDTH=100% BORDER=0><TR>";
	push @body, "<TD>Volumes containing dataset: $dataset</TD>";
	
	if($options{brief}) { 
		push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=full>";
		push @body, "<IMG border=0 alt=Expand onClick=\"ShowMessage()\" src=$options{expandButton}>";
		push @body, "</A></TD>"; 
	} else { 
		push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=brief>";
		push @body, "<IMG border=0 alt=Brief onClick=\"ShowMessage()\" src=$options{briefButton}>";
		push @body, "</A></TD>"; 
	}
	push @body, "</TR></TABLE>";
	
	push @body, "<TABLE BORDER=0>"; 
	
	# Write each volume info
	foreach $line (@sorted) {
		push @body, "<TD><A href=\"$ditdos?volume=@{$line}[1]\" onClick=\"ShowMessage()\">@{$line}[1]</A></DT></TD>";
		push @body, "<TD>";
		push @body, "<A HREF=$ditdos?order=@{$line}[1]><img border=0 src=\"$options{orderButton}\" alt=\"Order Volume\"></A>";
		if(stat("$options{errata}/@{$line}[1]")) {
			push @body, "<A HREF=$ditdos?errata=@{$line}[1]><img border=0 src=\"$options{errataButton}\" alt=\"Errata\"></A>";
		}
		$volume = VolumeFind($volumeList, @{$line}[1]);
		push @body, "</TD></TR>";
		if(defined $volume) {
	  		if($options{brief} == 1) { 
  				push @body, "<TR><TD></TD><TD>@{$volume}[3]</TD></TR>"; 
	  		} else { 
  				push @body, "<TR><TD></TD><TD>@{$volume}[4]</TD></TR>"; 
  			}
  		}
	}
	push @body, "</TABLE>";
	
	CreatePage(\%options, \@body);
}

# Print a list of datasets
# DSListPage(options, url, datasetList, phraseList)
sub DSListPage {
   my $arg = shift;
   my %options = %$arg;
   my $url = shift;
   my $datasetList = shift;
   my $phraseList = shift;

	my @body;   
	my @sorted;
	my @keyList;
	my @unique;
	my @finalList;
	my @part;
	
	my $line;
	my $buffer;
	my $temp;
	my $ditdos;
	my $volume;
	my $group;
	my $first = 1;
	
	# Initialize variables
	
	# Sort the list on dataset list
	# 0 = dataset_idt; 1 = volume_id
	@keyList = (0);	# DATASET_ID
	@unique = UniqueList($datasetList, \@keyList);
	@sorted = SortList(\@unique, \@keyList);	
	$buffer = "";
	
	# Now write HTML to display list
	push @body, "<TABLE WIDTH=100% BORDER=0><TR>";
	push @body, "<TD><H2>Available Datasets</H2></TD>";
	push @body, "</TR></TABLE>";
	
	push @body, "<TABLE BORDER=0>"; 
	
	$buffer = "";
	# Write each volume info
	foreach $line (@sorted) {
		@part = split('-', @{$line}[0]);
		if($group ne $part[0]) {
			$group = $part[0];
			$buffer = Translate($group, $phraseList);
			if(!$first) {
				push @body, "<TR>";
				push @body, "<TD>&nbsp;</TD>";
				push @body, "</TR>";
			}
			push @body, "<TR>";
			push @body, "<TD><B>$buffer</B></TD>";
			push @body, "</TR>";
			$first = 0;
		}		
		push @body, "<TR>";
		push @body, "<TD><A href=\"$ditdos?dataset=@{$line}[0]\" onClick=\"ShowMessage()\">@{$line}[0]</A></DT></TD>";
		push @body, "</TR>";
	}
	push @body, "</TABLE>";
	
	CreatePage(\%options, \@body);
}

# Format a list of datasets 
# FormatDatasets(options, volume, folder, path, volList)
sub FormatDatasets {
	my $arg = shift;
	my %options = %$arg;
	my $volume = shift;
	my $folder = shift;
	my $path = shift;
	$arg = shift;
	my @volList = @$arg;
	
	my @body;
	my $item;
	my $temp;
	my $style;
	
	if(scalar(@volList) == 0) { return @body; }
	
	if($options{brief}) { 
		$style = "brief";
	} else { 
		$style = "full";
	}
	
	push @body, "<H3>Datasets</H3>";
	foreach $item (@volList) {
		if(defined $folder) { $temp = $folder . "/"; }
		else { $temp = ""; }
		$temp .= $item;
		push @body, "&nbsp;&nbsp;&nbsp;&nbsp;<A href=$options{ditdos}?volume=$volume&folder=$temp&style=$style onClick=\"ShowMessage()\">$item</A> ";
	}
	
	return @body;
}

# Extracts the file extension from a file name.
# Returns the extension in upper case letters
# FileExt(name)
sub FileExt {
	my $name = shift;
	
	my @part;
	my $ext = "";
	
	@part = split('\.', $name, 2);
	if(scalar(@part) == 2) { $ext = uc($part[1]); }
	
	return $ext;
}
	
# Translates file extensions into file type names
# FileType(name, extList)
sub FileType {
	my $name = shift;
	my $arg = shift;
	my @extList;
	if(defined $arg) { @extList = @$arg; }
	
	my $type;
	my $ext;
	my $item;
	
	$ext = FileExt($name);
	if(defined $ext) {
		foreach $item (@extList) {
		   if($ext eq @$item[0]) { 
		   	$type = @$item[1];
		   	last;
		   }
		}
		if(!defined $type) { $type = $ext; }
	} else {
		$type = 'Data';
	}
	
	return $type;
}
	  
# Translates file extensions into HTML content type names
# ContentType(name, extList)
sub ContentType {
	my $name = shift;
	my $arg = shift;
	my @extList;
	if(defined $arg) { @extList = @$arg; }
	
	my $type;
	my $ext;
	my $item;
	
	$ext = FileExt($name);
	if(defined $ext) {
		foreach $item (@extList) {
		   if($ext eq @$item[0]) { 
		   	$type = @$item[2];
		   	last;
		   }
		}
		if(!defined $type) { $type = $ext; }
	} else {
		$type = 'application/octet-stream';
	}
	return $type;
}

# Extract a list of all referenced files from a label
# LabelReferences($path, $file)
sub LabelReferences {
	my $path = shift;
	my $file = shift;
	
	my $line;
	my $buffer;
	my @words;
	my @refList;
	
	if(open(FILE, "$path/$file")) {
		while($line = <FILE>) {
	   	chomp($line);
			if(substr($line, 0, 1) eq "#") { next; }  # Comment
	   	@words = split('=', $line, 2);
	   	if(scalar(@words) < 2) { next; }
	   	foreach $buffer (@words) { StripLTSpace($buffer); }
	   	if(substr($words[1], 0, 1) eq "^") { push(@refList, substr($words[1], 1)); }
		}
	  	close(FILE);
	}
	
	return @refList;
}

# Extract the description from a label file
# LabelDesc($path, $file, $brief)
sub LabelDesc {
	my $path = shift;
	my $file = shift;
	my $brief = shift;
	
	my $description;
	my $startTime;
	my $stopTime = "unknown";
	my @words;
	my @parts;
	my $inDesc;
	my $inNote;
	my $note;
	my $line;
	my $buffer;
	
	if(open(FILE, "$path/$file")) {
		while($line = <FILE>) {
	   	chomp($line);
	   	if($inDesc) {
	   	   if($line=~/"/) { $inDesc = 0; }
	   		$description = $description . "\n" . RemoveQuote($line);
	   		next;
	   	}
	   	if($inNote) {
	   	   if($line=~/"/) { $inNote = 0; }
	   		$note = $note . "\n" . RemoveQuote($line);
	   		next;
	   	}
	   	@words = split('=', $line, 2);
	   	if(scalar(@words) < 2) { next; }
	   	foreach $buffer (@words) { StripLTSpace($buffer); }
	   	$inDesc = 0;
	   	$inNote = 0;
	   	$words[0] = uc($words[0]);
	   	if($words[0] eq 'START_TIME') { $startTime = unquote($words[1]); }
	   	if($words[0] eq 'STOP_TIME') { $stopTime = unquote($words[1]); }
	   	if($words[0] eq 'NOTE') {
	   	   if(QuoteCount($words[1]) % 2 == 1) { $inNote = 1; }
				$note = RemoveQuote(unquote($words[1])); 
			}
	   	if($words[0] eq 'DESCRIPTION' && !defined $description) { # First description only
	   	   if(QuoteCount($words[1]) % 2 == 1) { $inDesc = 1; }
	   	   $description = RemoveQuote($words[1]); 
	   	}
		}
	  	close(FILE);
	} else {
		$buffer = "Unable to open file $path/$file. Please inform the Node operator.";
	}
	
	if(defined $startTime) {
		$buffer = "Span: $startTime to $stopTime.<BR>";
	}
	
	if(!defined $buffer) { $buffer = ""; }
	if(!defined $description) { $description = ""; }
	if(!defined $note) { $note = ""; }
	
	if($brief) { return $buffer; }
	
	return "$buffer $note $description";
}
		  
# Format a list of datasets 
# FormatFiles(options, volume, folder, path, fileList, extList)
sub FormatFiles {
	my $arg = shift;
	my %options = %$arg;
	my $volume = shift;
	my $folder = shift;
	my $path = shift;
	$arg = shift;
	my @fileList = @$arg;
	my $extList = shift;
	
	my @body;
	my $item;
	my @part;
	my $base;
	my $baseExt;
	my $name;
	my @nameList;
	my $temp;
	my $label;
	my @hideList;
	my @trueList;
	my @refList;
	my $good;

	# Quality assurance
	if(!defined $folder) { $folder= ""; }
		
	# Parse hideFile list and fix-up for pattern matching
	@hideList = split(',', $options{hideFile});
	foreach $temp (@hideList) { 
		StripLTSpace($temp); 
		$temp = uc($temp); 
		$temp=~s/\./\\./g;
		$temp=~s/\*/\.*/g;
	}
	foreach $name (@fileList) {
		$good = 1;
		$item = uc($name);
		foreach $temp (@hideList) {
		   if($item=~m/$temp/) {
		      $good = 0;
		      last;
		   }
		}
		if($good) { push @trueList, $name; }
	}
		      
	if(scalar(@trueList) == 0) { return @body; }
	
	# Process all files
	$base = "";
	$label = "";
	push @body, "<H3>Files</H3>";
	
	foreach $item (@trueList) {
		@part = split('\.', $item, 2);
		if($base ne $part[0]) {	# New file name
		   if(length($base) > 0) {	# If base name is active
				push @body, "<TABLE BORDER=0>";
				push @body, "<TR><TD>&nbsp;&nbsp;</TD><TD>$base</TD>";
		      foreach $name (@nameList) {
					if(FileExt($name) eq 'LBL') { $label = $name; }
				}
				# If there is a label file in the list - extract referenced files and add to list
				if(length($label) != 0) {
					@refList = LabelReferences($path, $label);
					push(@nameList, @refList);
				}
				# Format each file name in the list
		      foreach $name (@nameList) {
		      	$temp = FileType($name, $extList);
					push @body, "<TD><A href=$options{ditdos}?volume=$volume&folder=$folder&file=$name>$temp</A></TD>";
				}
				push @body, "</TR>";
				push @body, "</TABLE>";

				# Display description if there is a label file.				
				if(length($label) != 0) {
					push @body, "<TABLE BORDER=0>";
				   push @body, "<TR>";
					push @body, "<TD width=40></TD><TD>";
					push @body, LabelDesc($path, $label, $options{brief});
					push @body, "</TD>";
					push @body, "</TR>";
					push @body, "</TABLE>";
				}
			}
			$base = $part[0];
			$baseExt = $part[1];
			@nameList = ();
			$label = "";
		}
		push @nameList, $item;
	}
	
	# Now handle anything at the end
   if(length($base) > 0) {	# If base name is active
		push @body, "<TABLE BORDER=0>";
		push @body, "<TR><TD>&nbsp;&nbsp;</TD><TD>$base</TD>";
      foreach $name (@nameList) {
      	$temp = FileType($name, $extList);
			push @body, "<TD><A href=$options{ditdos}?volume=$volume&folder=$folder&file=$name>$temp</A></TD>";
			if(FileExt($name) eq 'LBL') { $label = $name; }
		}
		push @body, "</TR>";
		push @body, "</TABLE>";
		if(length($label) != 0) {
			push @body, "<TABLE BORDER=0>";
		   push @body, "<TR>";
			push @body, "<TD width=40></TD><TD>";
			push @body, LabelDesc($path, $label, $options{brief});
			push @body, "</TD>";
			push @body, "</TR>";
			push @body, "</TABLE>";
		}
	}
	
	return @body;
}
	
# Print table of contents for a volume
# DatasetPage(options, url, volume, folder, volumeList, extList)
sub DatasetPage {
   my $arg = shift;
   my %options = %$arg;
   my $url = shift;
   my $volume = shift;
   my $folder = shift;
   my $volumeList = shift;
   my $extList = shift;

	my @body;  
	my @files; 
	my @list;
	my $item;
	my $path;
	my $name;
	my $filler;
	my $slot;
	my $style;
	
	my @hideList;
	my @trueList;
	my $good;
	my $temp;
	my $folderName;
	
	# Initialize variables
	@body = ("");
		
	$item = VolumeFind($volumeList, $volume);	
	if(!defined $item) {
		push @body, "<H3>Error: Unknown volume \'$volume\'</H3>";
		CreatePage(\%options, \@body);
		return;
	}
	
	$filler = "";
	if(defined $folder) {
		$filler = "<B>- $folder</B>";
	}
	
	if(uc($slot) ne "OFF-LINE") {	# Try to mount volume
		JukeLock(1);	# Get exclusive use of jukebox
		$path = VolumeMount(\%options, @{$item}[0]);
		if(defined $folder) { $path .= "/$folder"; }
	}
	
	push @body, "<TABLE WIDTH=100% BORDER=0>";
	push @body, "<TR><TD VALIGN=top><TABLE><TR><TD><H2>@{$item}[1] $filler</H2></TD>";
	push @body, "<TD VALIGN=top ALIGN=left>";
	push @body, "<A HREF=$options{ditdos}?order=@{$item}[1]><img border=0 src=\"$options{orderButton}\" alt=\"Order the Volume\"></A>";
	if(stat("$options{errata}/@{$item}[1]")) {
		push @body, "<A HREF=$options{ditdos}?errata=@{$item}[1]><img border=0 src=\"$options{errataButton}\" alt=\"Errata\"></A>";
	}
	push @body, "</TD></TR></TABLE></TD>";
	# Now write HTML to display list
	if($options{brief}) { 
		push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=full>";
		push @body, "<IMG border=0 alt=Expand onClick=\"ShowMessage()\" src=$options{expandButton}>";
		push @body, "</A></TD>"; 
		$style = "brief";
	} else { 
		push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=brief>";
		push @body, "<IMG border=0 alt=Brief onClick=\"ShowMessage()\" src=$options{briefButton}>";
		push @body, "</A></TD>"; 
		$style = "full";
	}
	push @body, "</TR></TABLE>";
	
	if($options{brief} == 1) { 
		push @body, "@{$item}[3]"; 
	} else { 
		push @body, "@{$item}[4]"; 
	}
	
	$slot = @{$item}[0];
	if(uc($slot) eq "OFF-LINE") {	# Can only be ordered
		push @body, "<H3>This item is not available on-line.</H3>";
		push @body, "<TABLE BORDER=0>";
		push @body, "<TR><TD VALIGN=top>You can order this item by clicking the order icon</TD>";
		push @body, "<TD VALIGN=top>";
		push @body, "<A HREF=$options{ditdos}?order=@{$item}[1]><img border=0 src=\"$options{orderButton}\" alt=\"Order the Volume\"></A>";
		if(stat("$options{errata}/@{$item}[1]")) {
			push @body, "<A HREF=$options{ditdos}?errata=@{$item}[1]><img border=0 src=\"$options{errataButton}\" alt=\"Errata\"></A>";
		}
		push @body, "</TD>";
		push @body, "</TR></TABLE>";
		CreatePage(\%options, \@body);
		return;
	}

	# Load volume and display contents	
	
	if(opendir(DIR, $path)) {
		@files = grep(!/^\.\.?/, readdir DIR);
		closedir(DIR);
		# Extract the Directories from the list of files.
		@list = ExtractList($path, \@files, "d");
		
		# Filter out unwanted directories (folders)
		@hideList = split(',', $options{hideFolder});
		foreach $temp (@hideList) { StripLTSpace($temp); $temp = uc($temp); }
		foreach $name (@list) {
			$good = 1;
			$folderName = $name;
			$folderName = uc($folderName);
			foreach $temp (@hideList) {
			   if($temp eq $folderName) {
		      	$good = 0;
		   	   last;
			   }
			}
			if($good) { push @trueList, $name; }
		}
		push @body, FormatDatasets(\%options, @{$item}[1], $folder, $path, \@trueList);
		
	   # Extract the file names from the list of files.	
		@list = ExtractList($path, \@files, "f");
		push @body, FormatFiles(\%options, @{$item}[1], $folder, $path, \@list, $extList);
	} else {
		push(@body, "<P>Error displaying contents. Unable to open volume.");
	}
	JukeLock(0);	# Release exclusive use of jukebox

   CreatePage(\%options, \@body);
}

# Deliver a file through a redirect
# DeliverFile(options, url, volume, url, folder, file, volumeList, extList)
sub DeliverFile {
   my $arg = shift;
   my %options = %$arg;
   my $url = shift;
   my $volume = shift;
   my $folder = shift;
   my $file = shift;
   my $volumeList = shift;
	my $extList = shift;
	
	my @body;  
	my $path;
	my $item;
	my $pathName;
	my $filler;
	my $slot;
	my $style;
		
	# Initialize variables
	@body = ("");
		
	$item = VolumeFind($volumeList, $volume);	
	if(!defined $item) {
		push @body, "<H3>Error: Unknown volume \'$volume\'</H3>";
		CreatePage(\%options, \@body);
		return;
	}
	
	
	$slot = @{$item}[0];
	if(uc($slot) eq "OFF-LINE") {	# Can only be ordered
		if(defined $folder) {
			$filler = "<B>- $folder</B>";
		}
		push @body, "<TABLE BORDER=0>";
		push @body, "<TR><TD VALIGN=top><TABLE><TR><TD><H2>@{$item}[1] $filler</H2></TD>";
		push @body, "<TD VALIGN=top>";
		push @body, "<A HREF=$options{ditdos}?order=@{$item}[1]><img border=0 src=\"$options{orderButton}\" alt=\"Order the Volume\"></A>";
		if(stat("$options{errata}/@{$item}[1]")) {
			push @body, "<A HREF=$options{ditdos}?errata=@{$item}[1]><img border=0 src=\"$options{errataButton}\" alt=\"Errata\"></A>";
		}
		push @body, "</TD></TR></TABLE></TD>";
		if($options{brief}) { 
			push @body, "<TD VALIGN=top ALIGN=right><A HREF=$url&style=full>";
			push @body, "<IMG border=0 alt=Expand onClick=\"ShowMessage()\" src=$options{expandButton}>";
			push @body, "</A></TD>"; 
			$style = "brief";
		} else { 
			push @body, "<TD VALIGN=top, ALIGN=right><A HREF=$url&style=brief>";
			push @body, "<IMG border=0 alt=Brief  onClick=\"ShowMessage()\" src=$options{briefButton}>";
			push @body, "</A></TD>"; 
			$style = "full";
		}
		push @body, "</TR></TABLE>";
		
		if($options{brief} == 1) { 
			push @body, "@{$item}[3]"; 
		} else { 
			push @body, "@{$item}[4]"; 
		}
	
		push @body, "<H2>This item is not available on-line.</H2>";
		push @body, "<TABLE BORDER=0>";
		push @body, "<TR><TD VALIGN=top>You can order this item by clicking the order icon</TD>";
		push @body, "<TD VALIGN=top>";
		push @body, "<A HREF=$options{ditdos}?order=@{$item}[1]><img border=0 src=\"$options{orderButton}\" alt=\"Order the Volume\"></A>";
		if(stat("$options{errata}/@{$item}[1]")) {
			push @body, "<A HREF=$options{ditdos}?errata=@{$item}[1]><img border=0 src=\"$options{errataButton}\" alt=\"Errata\"></A>";
		}
		push @body, "</TD>";
		push @body, "</TR></TABLE>";
		CreatePage(\%options, \@body);
		return;
	}

	# Load volume and display contents	
	JukeLock(1);	# Get exclusive use of jukebox
	$path = VolumeMount(\%options, @{$item}[0]);
	if(defined $folder) { $path .= "/$folder"; }
	
	$pathName = "$path/$file";
	if(-f $pathName) {
		if(open(STREAM, $pathName)) {
			print header(-type => ContentType($pathName, $extList));
			binmode STREAM;
			binmode STDOUT;
			print <STREAM>;
			close(STREAM);
			return;
		}
	} 
	push @body, "Unable to find file: $file<BR>On volume: $volume<BR>In folder: $folder<BR>";
	push @body, "Full path: $pathName<BR>";
	JukeLock(1);	# Release exclusive use of jukebox

   CreatePage(\%options, \@body);
}

# Submit an order for a volume
# OrderVolume(options, volume, volumeList)
sub OrderVolume {
   my $arg = shift;
   my %options = %$arg;
   my $volume = shift;
   my $volumeList = shift;

	my @body;  
	my $item;
	
	# Initialize variables
	@body = ("");
		
	$item = VolumeFind($volumeList, $volume);	
	if(!defined $item) {
		push @body, "<H3>Error: Unknown volume \'$volume\'</H3>";
		CreatePage(\%options, \@body);
		return;
	}
	
	push @body, "<H2>Order for volume: $volume</H2>";
	push @body, "Instructions: Fill-in all fields, then select \"Send\".";
	push @body, "<HR>";
   push @body, "<form action=\"http:/cgi-bin/email\" method=POST>";
	push @body, "<input name=mailto type=HIDDEN value=ppiorder>";
   push @body, "<input name=subject type=hidden value=\"Order for $volume\">";
   push @body, "<input name=filler type=hidden value=\"order for the PDS volume: $volume\">";
   push @body, "Your name : <input name=name type=TEXT size=40 value><br>";
   push @body, "Your e-mail: <input name=from type=TEXT size=40 value><br>";
   push @body, "Shipping Instructions:<br>";
	push @body, "<textarea name=message cols=60 rows=10>";
	push @body, "</textarea><br>";
	push @body, "<pre><input type=reset value=Reset>                                         <input type=submit value=Send>";
	push @body, "</pre>";
	push @body, "</form>";

   CreatePage(\%options, \@body);
}

# Show inventory for the server
# ShowInventory(options, location, output, format, volumeList, datasetList)
sub ShowInventory {
   my $arg = shift;
   my %options = %$arg;
   my $location = shift;
   my $output = shift;
   my $format = shift;
   my $volumeList = shift;
   my $datasetList = shift;

	my $item;
	my $now;
	my $query;
	my $line;
	my $n;
	my @words;
	my @keyList;
	my @unique;
	my $requestHost;
	
	# Initialize variables
	$now = time();
	$query = new CGI;
	$line = $query->url();
	$n = index($line, '//');
	if($n != -1) { # Host name
   		@words = split('/', substr($line, $n + 2));
   		$requestHost = $words[0];
	}

	if($location eq "local") {
		print "# Inventory from: $requestHost\n";
		print "# Extracted: $now\n";			
		# List volume data base if no volume specified
		if($format eq "XML") {
			# Profile the product server
			print "<?xml version=\"1.0\"?>\n";
 			print "\n";
			print "<profile>\n";
			print "   <profAttributes>\n";
			print "       <profId>null</profId>\n";
			print "       <profVersion>null</profVersion>\n";
			print "       <profType>server</profType>\n";
			print "       <profDataDictId>null</profDataDictId>\n";
			print "   </proAttributes>\n";
			print "   <resAttributes>\n";
			print "      <Indentfier>PDS DITDOS Product Server</Identifier>\n";
			print "      <Title>PDS DITDOS Product Server</Title>\n";
			print "      <Language>En</Language>\n";	# Description
			print "      <resContext>NASA.PDS</resContext>\n";
			print "      <resAggregation>data.granule</resAggregation>\n";
			print "      <resClass>system.productServer</resClass>\n";
			print "      <resLocation>$options{ditdos}</resLocation>\n";	# Slot
			print "   </resAttributes>\n";
			print "</profile>\n";
			
			# Profile the data sets
			foreach $item (@$volumeList) {
				print "\n";
				print "<profile>\n";
				print "   <profAttributes>\n";
				print "       <profId>null</profId>\n";
				print "       <profVersion>null</profVersion>\n";
				print "       <profType>profile</profType>\n";
				print "   </proAttributes>\n";
				print "   <resAttributes>\n";
				print "      <Indentfier>" . 	@{$item}[1] . "</Identifier>\n";	# Volume_ID
				print "      <Title>" . 	@{$item}[3] . "</Title>\n";	# Volume_Name
				print "      <Description>" . 	@{$item}[4] . "</Description>\n";	# Description
				print "      <resContext>NASA.PDS</resContext>\n";
				print "      <resLocation>$options{ditdos}?volume=" . @{$item}[1] . "</resLocation>\n";	# Slot
				print "   </resAttributes>\n";
				print "   <profElement>\n";
				print "      <elemName>VOLUME_SERIES</elemName>\n";
				print "      <elemValue>" . @{$item}[2] . "</elemValue>\n";	# Volume_Series
				print "   </profElement>\n";
				print "</profile>\n";
				if(defined @{$item}[5]) {	# Browser defined
					print "\n";
					print "<profile>\n";
					print "   <profAttributes>\n";
					print "       <profId>null</profId>\n";
					print "       <profVersion>null</profVersion>\n";
					print "       <profType>profile</profType>\n";
					print "   </proAttributes>\n";
					print "   <resAttributes>\n";
					print "      <Indentfier>" . 	@{$item}[1] . "</Identifier>\n";	# Volume_ID
					print "      <Title>" . 	@{$item}[3] . "</Title>\n";	# Volume_Name
					print "      <Description>" . 	@{$item}[4] . "</Description>\n";	# Description
					print "      <resContext>NASA.PDS</resContext>\n";
					print "      <resLocation>" . @{$item}[5] . "</resLocation>\n";	# Slot
					print "   </resAttributes>\n";
					print "   <profElement>\n";
					print "      <elemName>VOLUME_SERIES</elemName>\n";
					print "      <elemValue>" . @{$item}[2] . "</elemValue>\n";	# Volume_Series
					print "   </profElement>\n";
					print "</profile>\n";
				}
			}
		} else { 
			if ($format eq "DIS") {	# Output in DIS format
				@keyList = (0);	# Sort on DATASET_ID
				@unique = UniqueList($datasetList, \@keyList);	
				print "dsid|nodeid|onlinenm|onlineid|protocoltype|userid|revdate|\n";
				foreach $item (@unique) {
					print @{$item}[0] . "|";  # DSID
					print "PPI-UCLA|"; # nodeid
					print "DITDOS Product Server|"; #onlinenm
					print "$options{ditdos}?volume=@{$item}[1]&dataset=@{$item}[0]|"; #onlineid
					print "URL|"; # Protocoltype
					print "N/A|"; # userid
					print scalar localtime() . "|"; # revdate
					print "\n"
				}
			} else {	# Do it in the PDS format
				if ($format eq "DSMAP") {	# Output in DIS format
					print "Dataset ID\t\tVolume ID\n";
					foreach $item (@$datasetList) {
						print @{$item}[0] . "\t" . @{$item}[1] . "\n";  # DSID
					}
				} else {	# Do it in the PDS format
					foreach $item (@$volumeList) {
						print "\n";
						print "SLOT = $options{ditdos}?volume=" . @{$item}[1] . "\n";	# Slot
						print "   VOLUME_ID = " . 	@{$item}[1] . "\n";	# Volume_ID
						print "   VOLUME_SERIES_NAME = \"" . @{$item}[2] . "\"\n";	# Volume_Series
						print "   VOLUME_NAME = \"" . 	@{$item}[3] . "\"\n";	# Volume_Name
						print "   DESCRIPTION = \"" . 	@{$item}[4] . "\"\n";	# Description
						print "   BROWSER = " . 	@{$item}[5] . "\n";	# Browser
						print "   DATA_SET_ID = " .     @{$item}[6] . "\n";     # Dataset ID list
					}
				}
			}
		}
	} else {	
		if($location=~m/^http:/i) { # Try to extract information from other host - print results
			my $res;
			my $url;
			
			$url = "$location?inventory=local&format=$format";
			my $ua = LWP::UserAgent->new;
			my $req = HTTP::Request->new(GET => $url);
			print "url: $url\n";
			if(defined($output)) {
				$res = $ua->request($req, $output);
			} else {
				$res = $ua->request($req);
		                print $res->as_string;
			}
			if (!$res->is_success) {	# Say why it failed
				print $res->status_line, "\n";
			}
		} else {	# Try as local directory
			if(defined($options{trusted})) {
				if(!TrustedHost(\%options)) {	# Only trusted hosts
					my $host = HostName();
					print "Attempting to do a local inventory from an unauthorized host ($host).\n";
					return; 
				}
			}
			my @pathList;
			my $item;
			my $webPath;
			
			select(STDOUT);
			if(defined($output)) {
				if(open(OUTPUT, ">$output")) {
					select(OUTPUT);
				}
			}
			@pathList = split(',', $location);
			foreach $item (@pathList) {	# Directory in location list
				StripLTSpace($item);
				if(!opendir(LOCDIR, $item)) {
					print "Unable to open directory.\n";
				} else {
					my @list;
					my $path;
					@list = sort grep {!/^\./} readdir(LOCDIR);
					foreach $line (@list) {
						$path = "$item/$line";
						$webPath = $path;
						$webPath =~ s%^$options{webPath}%%;
						$webPath =~ s/^\///;
						if(open(VOLDESC, "$path/voldesc.cat")) {
						   	print "SLOT=$path\r\n";
						   	if(-f "$path/aareadme.htm") {
						   		print "BROWSER=$options{browserServer}$webPath/aareadme.htm\n"
						   	}
						   	if(-f "$path/extras/map.htm") {
						   		print "MAP=$options{browserServer}$webPath/extras/map.htm\n"
						   	}
						   	print <VOLDESC>;
							close(VOLDESC);
						} else {	# Try upper case name
							if(open(VOLDESC, "$path/VOLDESC.CAT")) {
							   	print "SLOT=$path\n";
							   	if(-f "$path/AAREADME.HTM") {
							   		print "BROWSER=$options{browserServer}$webPath/AAREADME.HTM\n"
							   	}
							   	if(-f "$path/EXTRAS/MAP.HTM") {
							   		print "MAP=$options{browserServer}$webPath/EXTRAS/MAP.HTM\n"
							   	}
							   	print <VOLDESC>;
								close(VOLDESC);
							}
						}
					}
					closedir(LOCDIR);
				}
			}
			if(defined($output)) {
				close(OUTPUT);
				select(STDOUT);
			}
		}
	}
}

# Show errata for a value
# ShowErrata(options, volume, volumeList)
sub ShowErrata {
   my $arg = shift;
   my %options = %$arg;
   my $volume = shift;
   my $volumeList = shift;

	my @body;  
	my $line;
	my @list;
	my @info;
	my $update;
	my $now;
	
	# Initialize variables
	@body = ("");
		
	$now = time();
	# List volume data base if no volume specified
	if(length($volume) == 0) {
		push @body, "<H2>Errata $volume</H2>";
		if(!opendir(ERRDIR, $options{errata})) {
			push @body, "Unable to open errata database.";
			push @body, "Please inform the site <A href=\"$options{admin}\">administrator</A>.";
			push @body, "<\blockqoute>";
		} else {
			push @body, "<TABLE>";
			push @body, "<TR><TD ALIGN=CENTER><B>Volume</B></TD>";
			push @body, "<TD ALIGN=CENTER><B>Last update</B></TD>";
			push @body, "<TD ALIGN=CENTER><B>Changed Recently</B></TD></TR>";
		   # @list = grep { /^\./ && -f "$options{errata}/$_" } readdir(ERRDIR);
		   @list = sort grep {!/^\./} readdir(ERRDIR);
		   foreach $line (@list) {
			@info = stat("$options{errata}/$line");
			$update = localtime($info[9]);
			push @body, "<TR><TD><A HREF=$options{ditdos}?errata=$line>$line</A></TD>";
			push @body, "<TD>$update</TD>";
			push @body, "<TD ALIGN=CENTER>";
			if($now - $info[9] < 2592000) { # 30 days
			push @body, "<FONT COLOR=#FF0000>X</FONT>";
			} else {
			}
		        push @body, "</TD></TR>";
		   }
		   push @body, "</TABLE>";
		   closedir(ERRDIR);
		}
	} else {
		push @body, "<H2>Errata: $volume</H2>";
		push @body, "<pre>";
		if(!open(ERRATA, "$options{errata}/$volume/ERRATA.TXT")) {
		   push @body, "No errata found.";
		} else {
			while($line = <ERRATA>) {
				push @body, $line;
			}
			close(ERRATA);
		}
		push @body, "</pre>";
		
	}

   CreatePage(\%options, \@body);
}

# Creates an HTML page response using a template file.
# CreatePage(options, body)   
sub CreatePage {
   my $arg = shift;
   my %options = %$arg;
   my $body = shift;
   
   my $needResponse;
   my $line;
   
   $needResponse = 1;
   
	# Now generate the output - Based on template if one exists.	
	
	print header(-type => 'text/html');
	
	# replace the line containing <!insert body> with the body of the message
	if(open(TEMPLATE, $options{template})) {
		while(<TEMPLATE>) { 
			if(/<!insert body>/i) { 
			  	foreach $line (@$body) {
		  			print "$line\n";
				}
			} elsif(/<!insert date>/i) { print scalar localtime; }
			else { print $_; }
		}
		$needResponse = 0;
		close(TEMPLATE);
	}
	
	# If response has not been generated do so using a default template.
	if($needResponse) {
		print("<HTML>\n");
		print("<HEAD><TITLE>DITDOS Error Report</TITLE></HEAD>\n");
		
		# Start body here.
		print('<BODY vlink="#E3991C" alink="#0000FF" link="#008000" text="#000000">', "\n");
		print("<H1>DITDOS Error Report</H1>\n");
		foreach $line (@$body) {
		  print "$line\n";
		}
			
		print("</BODY>\n");
		print("</HTML>\n");
	}
}

# Return the current host name
# HostName()
sub HostName() {	
	my $requestHost = "";
	my $n;
	my @words;
	my $line;
	
	my $query = new CGI;
	$line = $query->url();
	
	$n = index($line, '//');
	if($n != -1) { # Host name
	   @words = split('/', substr($line, $n + 2));
	   $requestHost = $words[0];
	}
}

# Search if supported host to prevent spoofing
# TrustedHost(options)
sub TrustedHost {
	my $arg = shift;
	my %options = %$arg;
	
	my $line;
	my @trusted;
	my $requestHost = "";
	my $found;
	
	@trusted = split(',', $options{trusted});
	foreach $line (@trusted) {
		StripLTSpace($line);
	}
	
	$requestHost = HostName();
	
	$found = 0;
	foreach $line (@trusted) {
		if($line eq $requestHost) { $found = 1; last;}
	}
	
	return $found;
}

#--- Main program -------------

my $inventory = param('inventory');
my $output = param('output');
my $series = param('series');
my $volume = param('volume');
my $list = param('list');
my $order = param('order');
my $style = param('style');
my $folder = param('folder');
my $file = param('file');
my $filter = param('filter');
my $exclude = param('exclude');
my $title = param('title');
my $errata = param('errata');
my $format = param('format');
my $dataset = param('dataset');

my $datafile;
my $buffer;
my @seriesList;
my @volumeList;
my @datasetList;
my @filterList;
my @excludeList;
my @extList;
my $brief = 0;

# Options in configuration file
my %options = (
	template => "", 
	inventory => "",
	ditdos => "", 
	extension => "",
	errata => "",
	errataButton => "",
	orderButton => "",
	specialButton => "",
	firstBrowserButton => "",
	mapBrowserButton => "",
	brief => 0,
	hideFile => "",
	hideFolder => "",
	hideGroup => "",
	jukeload => "",
	reader1 => "",
	mount1 => "",
	admin => "",
	trusted => "",
	webPath => "",
	phrase => ""
);

# Variables
my $line;
my $temp;
my @body = ("");
my @words;
my @parts;
my @phrase;
my @fileList;
my @phraseList;
my $this;
my $url;
my $query;

# Label items
my $slot;
my $volume_id;
my $volume_name;
my $volume_series_name;
my $description;
my $inDesc;
my $inArray;
my $value;
my $browser;
my $map;
my $datasetArray;

# Load information from configuration file
# Comments begin with a '#'

if(open(CONFIG, "$0.cfg")) {	# Read script configuration file
	while($line = <CONFIG>) {
		chomp($line);
		if(substr($line, 0, 1) eq "#") { next; }  # Comment
		@words = split(/[ \t]/, $line, 2);
		if(scalar(@words) < 2 ) { next; }
		StripLTSpace($words[0]);
		StripLTSpace($words[1]);
		if($words[0] eq 'inventory') { $options{inventory} = $words[1]; }
		if($words[0] eq 'template') {	$options{template} = $words[1]; }
		if($words[0] eq 'browserServer') {	$options{browserServer} = $words[1]; }
		if($words[0] eq 'ditdos') {	$options{ditdos} = $words[1]; }
		if($words[0] eq 'orderButton') {	$options{orderButton} = $words[1]; }
		if($words[0] eq 'errataButton') {	$options{errataButton} = $words[1]; }
		if($words[0] eq 'specialButton') {	$options{specialButton} = $words[1]; }
		if($words[0] eq 'briefButton') {	$options{briefButton} = $words[1]; }
		if($words[0] eq 'expandButton') {	$options{expandButton} = $words[1]; }
		if($words[0] eq 'detailBrowserButton') {	$options{detailBrowserButton} = $words[1]; }
		if($words[0] eq 'mapBrowserButton') {	$options{mapBrowserButton} = $words[1]; }
		if($words[0] eq 'jukeload') {	$options{jukeload} = $words[1]; }
		if($words[0] eq 'hideFile') {	$options{hideFile} = $words[1]; }
		if($words[0] eq 'hideFolder') {	$options{hideFolder} = $words[1]; }
		if($words[0] eq 'reader1') {	$options{reader1} = $words[1]; }
		if($words[0] eq 'mount1') {	$options{mount1} = $words[1]; }
		if($words[0] eq 'extension') {	$options{extension} = $words[1]; }
		if($words[0] eq 'errata') {	$options{errata} = $words[1]; }
		if($words[0] eq 'admin') {	$options{admin} = $words[1]; }
		if($words[0] eq 'trusted') {	$options{trusted} = $words[1]; }
		if($words[0] eq 'webPath') {	$options{webPath} = $words[1]; }
		if($words[0] eq 'phrase') {	$options{phrase} = $words[1]; }
	}
	close(CONFIG);
} else {
   push @body, "Application is not configured properly. No configuration file found.";
	push @body, "Please inform the site administrator."
}

# Save the original URL
$query = new CGI;
$query->delete('style');
$url = $query->url(-full=>1,-query=>1);

# process options
if(defined $style) {
	if($style eq 'brief') { $options{brief} = 1; }
}
   
if(defined $filter) {
   @filterList = split(/,/, $filter);
   foreach $line (@filterList) { StripLTSpace($line); }
}
   
if(defined $series) {
   $series =~ s/_/ /g;
   @seriesList = split(/,/, $series);
   foreach $line (@seriesList) { StripLTSpace($line); }
}
   
if(defined $exclude) {
   @excludeList = split(/,/, $exclude);
   foreach $line (@excludeList) { StripLTSpace($line); }
}

if(defined $title) {
   $title =~ s/_/ /g;
}

if(!defined $format) { $format = "PDS"; }
   
# Open each inventory (catalog) file and load contents
@fileList = glob("$options{inventory}/*.cat");
foreach $this (@fileList) {
	if(open(INV, $this)) {
	   $slot = "";
	   $volume_id = "";
	   $volume_series_name = "";
	   $volume_name = "";
	   $description = "";
	   $browser = "";
	   $map = "";
	   $datasetArray = "";
	   $inDesc = 0;
	   $inArray = 0;
	   
	   while($line = <INV>) {
		if(substr($line, 0, 1) eq "#") { next; } # Comment
	   	chomp($line);
	   	if($inArray) {
	   		$value = $value . $line;
	   		if($line =~ m/}/) { $inArray = 0; }
	   		# print "Value: $value\n"
	   	} else {
	   		$value = $line;
	   	}
   		if($line =~ m/{/) { 
   			if($line =~ m/}/) { $inArray = 0; } else { $inArray = 1; next; }
   		}
	   	@words = split('=', $value, 2);
	   	foreach $buffer (@words) { StripLTSpace($buffer); }
	   	if(scalar(@words) < 2) { 
	   		if($inDesc) {
		   		$description = $description . "\n" . RemoveQuote($line);
		   	}
	   		next;
	   	}
	   	$inDesc = 0;
	   	$words[0] = uc($words[0]);
	   	if($words[0] eq 'SLOT') { # New entry - add previous entry to list if there is one.
	   	   if(length($slot) > 0) { 
	   	   	if(length($volume_id) > 0) { 
	   	   	   $description = FixupDesc($description);
	   	   		push(@volumeList, 
	   	   			[$slot, $volume_id, $volume_series_name, $volume_name, $description, $browser, $map, $datasetArray]); 
	   	   			
	   	   		if(length($datasetArray) > 0) {
		   	   	        $datasetArray =~ s/"//g; # Remove string quotes
					$datasetArray =~ s/{//;	# Remove list quotes
					$datasetArray =~ s/}//;
					StripLTSpace($datasetArray);
	   	   			@parts = split(',', $datasetArray);
	   	   			foreach $buffer (@parts) { 
	   	   				StripLTSpace($buffer); 
	   	   				$buffer = unquote($buffer); 
	   	   				push(@datasetList, [$buffer, $volume_id]);
	   	   			}
	   	   		}
	   	   		
		   		# Reset variables
		   		$volume_id = "";
		   		$volume_series_name = "";
		   		$volume_name = "";
		   		$description = "";
		   		$browser = "";
		   		$map = "";
		   		$datasetArray = "";
	   	   	}
	   	   }
	   	   $slot = $words[1]; 
	   	   $volume_id = ""; 
	   	}
	   	if($words[0] eq 'VOLUME_ID') { $volume_id = unquote($words[1]); }
	   	if($words[0] eq 'VOLUME_SERIES_NAME') { $volume_series_name = ProperCase(unquote($words[1])); }
	   	if($words[0] eq 'VOLUME_NAME') { $volume_name = unquote($words[1]); }
	   	if($words[0] eq 'BROWSER') { $browser = unquote($words[1]); }
	   	if($words[0] eq 'MAP') { $map = unquote($words[1]); }
	   	if($words[0] eq 'DATA_SET_ID') { $datasetArray = $words[1]; }
	   	if($words[0] eq 'DESCRIPTION' ) {
	   	   $inDesc = 1;
	   	   $description = RemoveQuote($words[1]); 
	   	}
	   }
	   if(length($slot) > 0) {	# If there's an entry add it to list
	   	if(length($volume_id) > 0) { 
	   	   $description = FixupDesc($description);
	   		push(@volumeList, 
	   			[$slot, $volume_id, $volume_series_name, $volume_name, $description, $browser, $map, $datasetArray]); 
	   	   	if(length($datasetArray) > 0) {
	   	   	        $datasetArray = unquote($datasetArray);
				$datasetArray =~ s/{//;	# Remove list quotes
				$datasetArray =~ s/}//;
	   	   		@parts = split(',', $datasetArray);
	   	   		foreach $buffer (@parts) { 
	   	   			StripLTSpace($buffer); 
	   	   			$buffer = unquote($buffer); 
	   	   			push(@datasetList, [$buffer, $volume_id]);
	   	   		}
	   	   	}
	   	}
	   }
		close(INV);
	} else {
		push @body, "Unable to open inventory file $this.";
		push @body, "Please inform the site <A href=\"$options{admin}\">administrator</A>.";
		CreatePage(\%options, \@body);
		exit;
	}
}

# Check if request is for inventory
if(defined($inventory)) {
	ShowInventory(\%options, $inventory, $output, $format, \@volumeList, \@datasetList);
	exit;
}
# Check if request is to list errata
if(defined($errata)) {
	ShowErrata(\%options, $errata, \@volumeList);
	exit;
}

# Check if request is an order
if(defined($order)) {
	OrderVolume(\%options, $order, \@volumeList);
  	exit;
}

# If dataset is defined show all volumes containing dataset
if(defined $dataset) {
	if($dataset eq "*") {		# Show list of all datasets
		# We'll need the phrase table if defined
		if(defined $options{phrase}) { #load phrase table translation
			if(open(TEXT, $options{phrase})) {
				while($line = <TEXT>) {
					if(substr($line, 0, 1) eq "#") { next; }	# Comment
				   	chomp($line);
				   	@words = split(/[ \t]/, $line, 2);
				   	if(scalar(@words) < 2) { next; }
			   		StripLTSpace($words[0]); StripLTSpace($words[1]);
			   		push @phraseList, [$words[0], $words[1]];
				}
				close(TEXT);
			}
		} else {
			push @body, "Unable to open translation file $options{phrase}.";
  			push @body, "Please inform the site <A href=\"$options{admin}\">administrator</A>.";
	   		CreatePage(\%options, \@body);
		}
		DSListPage(\%options, $url, \@datasetList, \@phraseList);
	} else {	# Show volume containing dataset
		DSVolumePage(\%options, $url, $dataset, \@datasetList, \@volumeList);
	}
	exit;
}

# If a volume is defined then we'll need the extension translation
# table. Open and load it.
if(defined $volume) {
	if(defined $options{extension}) { #load extension table translation
		if(open(EXT, $options{extension})) {
		   while($line = <EXT>) {
				if(substr($line, 0, 1) eq "#") { next; }	# Comment
		   	chomp($line);
		   	@words = split(/[ \t]/, $line, 2);
		   	if(scalar(@words) < 2) { next; }
		   	StripLTSpace($words[0]); StripLTSpace($words[1]);
	   	   if(length($words[0]) > 0) { 
	   	   	if(length($words[1]) > 0) { 
   	   			@parts = split(/[ \t]/, $words[1], 2);
						StripLTSpace($parts[0]);
	   	   		if(scalar(@parts) > 1) { 
							StripLTSpace($words[1]);
	   	   			push @extList, [$words[0], $parts[0], $parts[1]] 
	   	   		} else { push @extList, [$words[0], $parts[0], ""]; }
		   	   }
		   	}
		   }
		   close(EXT);
		} else {
			push @body, "Unable to open translation file $options{extensions}.";
  			push @body, "Please inform the site <A href=\"$options{admin}\">administrator</A>.";
   			CreatePage(\%options, \@body);
		}
	}
}

# Build page describing things
if(!defined $series && !defined $volume && scalar(@filterList) == 0 && scalar(@excludeList) == 0) { 	# Show all series
	SeriesPage(\%options, $title, \@filterList, \@excludeList, \@volumeList); 
} else {
	if(!defined $volume) { # Show all volumes for each series
		VolumePage(\%options, $title, $url, \@seriesList, \@filterList, \@excludeList, \@volumeList); 
	} else {	# Show information for a volume
		if(!defined $file) {
  	 		DatasetPage(\%options, $url, $volume, $folder, \@volumeList, \@extList);
   		} else {
			DeliverFile(\%options, $url, $volume, $folder, $file, \@volumeList, \@extList);   	
		}
   	}
}