#!/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) {
if(defined(@$item1[$key]) && defined(@$item2[$key])) {
$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);
$item1 = "";
$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(defined($filter) && defined(@$item[$key])) {
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;
}
# Merge one list with another without duplicates
# MergeList(list1, list2)
sub MergeList {
my $list1 = shift;
my $list2 = shift;
my $found;
my $item1;
my $item2;
foreach $item2 (@$list2) {
$found = 0;
foreach $item1 (@$list1) {
if(lc($item1) eq lc($item2)) { $found = 1; last; }
}
if(! $found) { push(@$list1, $item2); }
}
return @$list1
}
# 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; }
if ($slot =~ /^-?\d/) {
} else { 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;
}
# Provides download instructions
# Instructions(count)
sub Instructions {
my $count = shift;
my @text;
# Add instructions
push @text, "";
if($count > 1) {
push @text, "
";
push @text, "Note: The selected data have more than one associated file.
";
push @text, "You must download each file in order to properly use the data.";
push @text, "";
}
push @text, "
To download an individual file with:";
push @text, "
";
push @text, " | Internet Explorer | ";
push @text, "Right-click on the link and select \"Save Target as..\" |
";
push @text, " | Netscape | ";
push @text, "Right-click on the link and select \"Save Link as..\" |
";
push @text, "
";
push @text, "";
return @text;
}
# 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;
my $series;
my $seriesName;
my $first = 1;
# Initialize variables
if(defined $title) { @body = ("
$title
"); }
# 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, "";
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];
if(! defined($series)) { $series = ""; }
$seriesName = $series;
$series =~ s/ /_/g;
push @body, "$seriesName | ";
push @body, "
";
}
push @body, " |
";
push @body, "All Data Volumes | ";
push @body, "
";
push @body, "
";
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 $inTable = 0;
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
#print "volumeList: " . scalar(@$volumeList) . "\n";
#print "seriesList: " . scalar(@$seriesList) . "\n";
#print "filterList: " . scalar(@$filterList) . "\n";
@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, "";
if(defined $title) { push @body, "$title | ";
} else { push @body, " | "; }
if($options{brief}) {
push @body, "";
push @body, " | ";
$style = "brief";
} else {
push @body, "";
push @body, " | ";
$style = "full";
}
push @body, "
";
# Write each volume info
if(defined $title) {
push @body, ""; $first = 0; $inTable = 1;
}
$buffer = "";
if(scalar(@sorted) == 0) {
push @body, "No matching volumes"
}
foreach $line (@sorted) {
if(defined @$line[2]) { if($buffer ne @$line[2]) { $first = 1; } }
if($first) { # Insert a title
if($inTable) { push @body, "
"; }
push @body, "@{$line}[2]
";
push @body, "";
$buffer = @$line[2];
$first = 0;
$inTable = 1;
}
$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, "@{$line}[1] | ";
push @body, "";
push @body, "";
if(stat("$options{errata}/@{$line}[1]")) {
push @body, "";
}
if(length(@{$line}[5]) != 0) { # Detail Browser defined
push @body, "";
}
if(length(@{$line}[6]) != 0) { # Map Browser defined
push @body, "";
}
push @body, " | ";
push @body, " | ";
if($options{brief} == 1) {
push @body, "@{$line}[3]";
} else {
push @body, "@{$line}[4]";
}
push @body, " |
";
}
if($inTable) { push @body, "
"; }
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 $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, "";
push @body, "";
# Write each volume info
foreach $line (@sorted) {
push @body, "@{$line}[1] | ";
push @body, "";
push @body, "";
if(stat("$options{errata}/@{$line}[1]")) {
push @body, "";
}
$volume = VolumeFind($volumeList, @{$line}[1]);
if(length(@{$volume}[5]) != 0) { # Detail Browser defined
push @body, "";
}
if(length(@{$volume}[6]) != 0) { # Map Browser defined
push @body, "";
}
push @body, " | ";
if(defined $volume) {
push @body, " | ";
if($options{brief} == 1) {
push @body, "@{$volume}[3]";
} else {
push @body, "@{$volume}[4]";
}
push @body, " |
";
}
}
push @body, "
";
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 $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, "";
push @body, "Available Datasets | ";
push @body, "
";
push @body, "";
$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, "";
push @body, " | ";
push @body, "
";
}
push @body, "";
push @body, "$buffer | ";
push @body, "
";
$first = 0;
}
push @body, "";
push @body, "@{$line}[0] | ";
push @body, "
";
}
push @body, "
";
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, "Datasets
";
foreach $item (@volList) {
if(defined $folder) { $temp = $folder . "/"; }
else { $temp = ""; }
$temp .= $item;
push @body, " $item ";
}
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';
}
$type =~ s/_/ /g;
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 file reference from a string.
# ExtractFile($file)
sub ExtractFile {
my $file = shift;
my @words;
@words = split('"', $file);
if(scalar(@words) > 1) { $file = $words[1]; }
# Remove literal quotes - if any
$file =~ s/'//g;
return $file
}
# 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 = ) {
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[0], 0, 1) eq "^") {
push(@refList, ExtractFile($words[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;
my $useDesc = 0;
my $useNote = 0;
if(open(FILE, "$path/$file")) {
while($line = ) {
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(!$useDesc) { $useNote = 1; }
if(QuoteCount($words[1]) % 2 == 1) { $inNote = 1; }
$note = RemoveQuote(unquote($words[1]));
}
if($words[0] eq 'DESCRIPTION' && !defined $description) { # First description only
if(!$useNote) { $useDesc = 1; }
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.
";
}
if(!defined $buffer) { $buffer = ""; }
if(!defined $description) { $description = ""; }
if(!defined $note) { $note = ""; }
if($useNote) { $description = ""; }
if($useDesc) { $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 $name;
my @nameList;
my $temp;
my $label;
my @hideList;
my @trueList;
my @refList;
my $good;
my $type;
my $fullpath;
# Quality assurance
if(!defined $folder) { $folder= ""; }
$temp = substr($path, length($path)-1);
if($temp eq '/') { chop($path); }
# 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, "Files
";
foreach $item (@trueList) {
@part = split('\.', $item, 2);
if($base ne $part[0]) { # New file name
if(length($base) > 0) { # If base name has been set
push @body, "";
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);
@nameList = MergeList(\@nameList, \@refList);
}
push @body, " | ";
if(scalar @nameList > 1) {
push @body, "$base | ";
} else {
$type = FileType($nameList[0], $extList);
push @body, "$nameList[0] ($type) | ";
}
push @body, "
";
push @body, "
";
# Display description if there is a label file.
if(length($label) != 0) {
$fullpath = $options{webPath} . $path;
push @body, "";
push @body, "";
push @body, " | ";
push @body, "";
push @body, LabelDesc($fullpath, $label, $options{brief});
push @body, " ";
push @body, " | ";
push @body, "
";
push @body, "
";
}
}
$base = $part[0];
@nameList = ();
$label = "";
}
push @nameList, $item;
}
# Now handle anything at the end
if(length($base) > 0) { # If base name is active
push @body, "";
push @body, " | ";
foreach $name (@nameList) {
$temp = FileType($name, $extList);
if(FileExt($name) eq 'LBL') { $label = $name; }
}
if(scalar @nameList > 1) {
push @body, "$base | ";
} else {
$type = FileType($nameList[0], $extList);
push @body, "$nameList[0] ($type) | ";
}
push @body, "
";
push @body, "
";
if(length($label) != 0) {
$fullpath = $options{webPath} . $path;
push @body, "";
push @body, "";
push @body, " | ";
push @body, "";
push @body, LabelDesc($fullpath, $label, $options{brief});
push @body, " ";
push @body, " | ";
push @body, "
";
push @body, "
";
}
}
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 $fullpath;
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, "Error: Unknown volume \'$volume\'
";
CreatePage(\%options, \@body);
return;
}
$filler = "";
if(defined $folder) {
$filler = "- $folder";
}
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, "";
push @body, "@{$item}[1] $filler | ";
push @body, "";
push @body, "";
if(stat("$options{errata}/@{$item}[1]")) {
push @body, "";
}
push @body, " |
| ";
# Now write HTML to display list
if($options{brief}) {
push @body, "";
push @body, "";
push @body, " | ";
$style = "brief";
} else {
push @body, "";
push @body, "";
push @body, " | ";
$style = "full";
}
push @body, "
";
push @body, " | ";
if($options{brief} == 1) {
push @body, "@{$item}[3]";
} else {
push @body, "@{$item}[4]";
}
push @body, " |
";
$slot = @{$item}[0];
if(uc($slot) eq "OFF-LINE") { # Can only be ordered
push @body, "This item is not available on-line.
";
push @body, "";
push @body, "You can order this item by clicking the order icon | ";
push @body, "";
push @body, "";
if(stat("$options{errata}/@{$item}[1]")) {
push @body, "";
}
push @body, " | ";
push @body, "
";
CreatePage(\%options, \@body);
return;
}
# Load volume and display contents
$fullpath = $options{webPath} . $path;
if(opendir(DIR, $fullpath)) {
@files = grep(!/^\.\.?/, readdir DIR);
closedir(DIR);
# Extract the Directories from the list of files.
@list = ExtractList($fullpath, \@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);
# Look for "SUPERSEDE.HTM file and insert contents
$temp = $fullpath . "/SUPERSEDE.HTM";
if(open(FILEREAD, "< $temp")) {
while (){
push @body, $_;
}
close(FILEREAD);
}
# Extract the file names from the list of files.
@list = ExtractList($fullpath, \@files, "f");
push @body, FormatFiles(\%options, @{$item}[1], $folder, $path, \@list, $extList);
push @body, Instructions(0);
} else {
push(@body, "Error displaying contents. Unable to open volume.");
push(@body, "path: $path
");
push(@body, "@{$item}[0]");
}
# JukeLock(0); # Release exclusive use of jukebox
CreatePage(\%options, \@body);
}
# DeliverFile(options, url, volume, 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 $temp;
my $path;
my $item;
my $fullpath;
my $filler;
my $slot;
my $style;
my @part;
my @nameList;
my $name;
my $label;
my $base;
my $type;
my @refList;
# Initialize variables
@body = ("");
$item = VolumeFind($volumeList, $volume);
if(!defined $item) {
push @body, "
Error: Unknown volume \'$volume\'
";
CreatePage(\%options, \@body);
return;
}
$slot = @{$item}[0];
if(uc($slot) eq "OFF-LINE") { # Can only be ordered
if(defined $folder) {
$filler = "- $folder";
}
push @body, "";
push @body, "@{$item}[1] $filler | ";
push @body, "";
push @body, "";
if(stat("$options{errata}/@{$item}[1]")) {
push @body, "";
}
push @body, " |
| ";
if($options{brief}) {
push @body, "";
push @body, "";
push @body, " | ";
$style = "brief";
} else {
push @body, "";
push @body, "";
push @body, " | ";
$style = "full";
}
push @body, "
";
if($options{brief} == 1) {
push @body, "@{$item}[3]";
} else {
push @body, "@{$item}[4]";
}
push @body, "This item is not available on-line.
";
push @body, "";
push @body, "You can order this item by clicking the order icon | ";
push @body, "";
push @body, "";
if(stat("$options{errata}/@{$item}[1]")) {
push @body, "";
}
push @body, " | ";
push @body, "
";
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"; }
$fullpath = $options{webPath} . $path;
if(opendir(DIR, $fullpath)) {
@nameList = grep(/^$file\./, readdir DIR);
closedir(DIR);
}
$temp = substr($path, length($path)-1);
if($temp eq '/') { chop($path); }
if(scalar @nameList < 1) { # No files
push @body, "Unable to find file: $file
On volume: $volume
In folder: $folder
";
push @body, "Full path: $path
";
} else {
@part = split('\.', $file, 2);
foreach $name (@nameList) {
if(FileExt($name) eq 'LBL') { $label = $name; }
}
push @body, "";
push @body, "";
push @body, "$file | ";
push @body, "";
push @body, "
";
# Display description if there is a label file.
if(length($label) != 0) {
$fullpath = $options{webPath} . $path;
push @body, "";
push @body, "";
push @body, " | ";
push @body, "";
push @body, LabelDesc($fullpath, $label, $options{brief});
push @body, " ";
push @body, " | ";
push @body, "
";
push @body, "
";
# extract referenced files and add to list
@refList = LabelReferences($path, $label);
@nameList = MergeList(\@nameList, \@refList);
}
# Format each file name in the list
push @body, "";
push @body, " | |
";
push @body, "Files | |
";
foreach $name (@nameList) {
$type = FileType($name, $extList);
push @body, " | $name ($type) |
";
}
push @body, "
";
# Add instructions
push @body, Instructions(scalar @nameList);
}
# 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, "Error: Unknown volume \'$volume\'
";
CreatePage(\%options, \@body);
return;
}
push @body, "Order for volume: $volume
";
push @body, "Instructions: Fill-in all fields, then select \"Send\".";
push @body, "
";
push @body, "";
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 = scalar localtime();
$query = new CGI;
$line = $query->url();
$n = index($line, '//');
if($n != -1) { # Host name
@words = split('/', substr($line, $n + 2));
$requestHost = $words[0];
}
select(STDOUT);
if(defined($output)) {
if(open(OUTPUT, ">$output")) {
print "OUTPUT: $output\n";
select(OUTPUT);
} else {
print "Failed to open: $output\n";
}
}
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 "\n";
print "\n";
print "\n";
print " \n";
print " null\n";
print " null\n";
print " server\n";
print " null\n";
print " \n";
print " \n";
print " PDS DITDOS Product Server\n";
print " PDS DITDOS Product Server\n";
print " En\n"; # Description
print " NASA.PDS\n";
print " data.granule\n";
print " system.productServer\n";
print " $options{ditdos}\n"; # Slot
print " \n";
print "\n";
# Profile the data sets
foreach $item (@$volumeList) {
print "\n";
print "\n";
print " \n";
print " null\n";
print " null\n";
print " profile\n";
print " \n";
print " \n";
print " " . @{$item}[1] . "\n"; # Volume_ID
print " " . @{$item}[3] . "\n"; # Volume_Name
print " " . @{$item}[4] . "\n"; # Description
print " NASA.PDS\n";
print " $options{ditdos}?volume=" . @{$item}[1] . "\n"; # Slot
print " \n";
print " \n";
print " VOLUME_SERIES\n";
print " " . @{$item}[2] . "\n"; # Volume_Series
print " \n";
print "\n";
if(defined @{$item}[5]) { # Browser defined
print "\n";
print "\n";
print " \n";
print " null\n";
print " null\n";
print " profile\n";
print " \n";
print " \n";
print " " . @{$item}[1] . "\n"; # Volume_ID
print " " . @{$item}[3] . "\n"; # Volume_Name
print " " . @{$item}[4] . "\n"; # Description
print " NASA.PDS\n";
print " " . @{$item}[5] . "\n"; # Slot
print " \n";
print " \n";
print " VOLUME_SERIES\n";
print " " . @{$item}[2] . "\n"; # Volume_Series
print " \n";
print "\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}?dataset=@{$item}[0]|"; #onlineid
print "URL|"; # Protocoltype
print "N/A|"; # userid
print scalar localtime() . "|"; # revdate
print "\n"
}
} else {
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 {
if($format eq "CATALOG") { # Output in CATALOG format
# All volumes
foreach $item (@$volumeList) {
print "$options{ditdos}?volume=@{$item}[1]";
print ",@{$item}[1]";
print ",DITDOS_" . @{$item}[1];
print ",application.dataVolumeRemote,PPI-UCLA,\n";
}
# All datasets
foreach $item (@$datasetList) {
print "$options{ditdos}?dataset=@{$item}[0]";
print ",@{$item}[0]";
print ",DITDOS_" . @{$item}[0];
print ",application.dataSetBrowserP,PPI-UCLA,\n";
}
} 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;
@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 ;
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 ;
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 $buffer;
my @list;
my @info;
my $update;
my $now;
my $checkHeader;
my $inLabel;
my $errataFound;
my @files;
my $path;
# Initialize variables
@body = ("");
$now = time();
# List volume data base if no volume specified
if(length($volume) == 0) {
push @body, "Errata $volume
";
if(!opendir(ERRDIR, $options{errata})) {
push @body, "Unable to open errata database.";
push @body, "Please inform the site administrator.";
push @body, "<\blockqoute>";
} else {
push @body, "";
push @body, "Volume | ";
push @body, "Last update | ";
push @body, "Changed Recently |
";
# @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, "$line | ";
push @body, "$update | ";
push @body, "";
if($now - $info[9] < 2592000) { # 30 days
push @body, "X";
} else {
}
push @body, " |
";
}
push @body, "
";
closedir(ERRDIR);
}
} else {
push @body, "Errata: $volume
";
push @body, "";
if(!open(ERRATA, "$options{errata}/$volume/ERRATA.TXT")) {
$errataFound = 0;
$path = "$options{errata}/$volume";
if(opendir(ERRDIR, $path)) {
@files = sort grep {!/^\./} readdir(ERRDIR);
close(ERRDIR);
# Extract the Directories from the list of files.
@list = ExtractList($path, \@files, "d");
foreach $line (@list) {
@info = stat("$path/$line/ERRATA.TXT");
if(@info) {
# Format new errata link
if(!$errataFound) {
push @body, "
";
push @body, "Sub-volumes: |
"
}
push @body, " | ";
push @body, "$line |
";
$errataFound = 1;
}
}
if($errataFound) { push @body, "
"; }
}
if(! $errataFound) { push @body, "No errata found."; }
} else {
$checkHeader = 1;
$inLabel = 0;
while($line = ) {
if($checkHeader) {
$buffer = $line;
StripLTSpace($buffer);
if($buffer=~m/^PDS_VERSION_ID/i) { # Start of attached label
$inLabel = 1;
next;
}
$checkHeader = 0;
}
if($inLabel) { # Look for "END"
$buffer = $line;
StripLTSpace($buffer);
if($buffer=~m/^END$/i) {
$inLabel = 0;
}
next;
}
StripTSpace($line);
push @body, $line;
}
close(ERRATA);
}
push @body, "";
}
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 with the body of the message
if(open(TEMPLATE, $options{template})) {
while() {
if(//i) {
foreach $line (@$body) {
print "$line\n";
}
} elsif(//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("\n");
print("DITDOS Error Report\n");
# Start body here.
print('', "\n");
print("DITDOS Error Report
\n");
foreach $line (@$body) {
print "$line\n";
}
print("\n");
print("\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, "ditdos.cfg")) { # Read script configuration file
while($line = ) {
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 = ) {
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 administrator.";
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 = ) {
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 administrator.";
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 = ) {
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{extension}.";
push @body, "Please inform the site administrator.";
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);
}
}
}