#!/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, ""; push @text, ""; push @text, ""; push @text, ""; push @text, "
Internet Explorer  Right-click on the link and select \"Save Target as..\"
NetscapeRight-click on the link and select \"Save Link as..\"
"; 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, ""; push @body, ""; } push @body, ""; push @body, ""; push @body, ""; push @body, "
$seriesName
 
All Data Volumes
"; 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, ""; } else { push @body, ""; } if($options{brief}) { push @body, ""; $style = "brief"; } else { push @body, ""; $style = "full"; } push @body, "

$title

 "; push @body, "Expand"; push @body, "Brief
"; # 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, ""; push @body, ""; push @body, ""; } if($inTable) { push @body, "
@{$line}[1]"; push @body, "\"Order"; if(stat("$options{errata}/@{$line}[1]")) { push @body, "\"Errata\""; } if(length(@{$line}[5]) != 0) { # Detail Browser defined push @body, "\"Detail"; } if(length(@{$line}[6]) != 0) { # Map Browser defined push @body, "\"Map"; } push @body, "
"; 
  		if($options{brief} == 1) { 
  			push @body, "@{$line}[3]"; 
  		} else { 
  			push @body, "@{$line}[4]"; 
  		}
  		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, ""; if($options{brief}) { push @body, ""; } else { push @body, ""; } push @body, "
Volumes containing dataset: $dataset"; push @body, "Expand"; push @body, ""; push @body, "Brief"; push @body, "
"; push @body, ""; # Write each volume info foreach $line (@sorted) { push @body, ""; push @body, ""; if(defined $volume) { push @body, ""; } } push @body, "
@{$line}[1]"; push @body, "\"Order"; if(stat("$options{errata}/@{$line}[1]")) { push @body, "\"Errata\""; } $volume = VolumeFind($volumeList, @{$line}[1]); if(length(@{$volume}[5]) != 0) { # Detail Browser defined push @body, "\"Detail"; } if(length(@{$volume}[6]) != 0) { # Map Browser defined push @body, "\"Map"; } push @body, "
"; 
	  		if($options{brief} == 1) { 
  				push @body, "@{$volume}[3]"; 
	  		} else { 
  				push @body, "@{$volume}[4]"; 
  			}
  			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, ""; push @body, "

Available Datasets

"; 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, ""; push @body, ""; $first = 0; } push @body, ""; push @body, ""; push @body, ""; } push @body, "
 
$buffer
@{$line}[0]
"; 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, ""; } else { $type = FileType($nameList[0], $extList); push @body, ""; } push @body, ""; push @body, "
  $base$nameList[0] ($type)
"; # 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, "
"; push @body, "
";
				push @body, LabelDesc($fullpath, $label, $options{brief});
				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, ""; } else { $type = FileType($nameList[0], $extList); push @body, ""; } push @body, ""; push @body, "
  $base$nameList[0] ($type)
"; if(length($label) != 0) { $fullpath = $options{webPath} . $path; push @body, ""; push @body, ""; push @body, ""; push @body, ""; push @body, "
"; push @body, "
";
			push @body, LabelDesc($fullpath, $label, $options{brief});
			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, ""; # Now write HTML to display list if($options{brief}) { push @body, ""; $style = "brief"; } else { push @body, ""; $style = "full"; } push @body, "
"; push @body, "

@{$item}[1] $filler

"; push @body, "\"Order"; if(stat("$options{errata}/@{$item}[1]")) { push @body, "\"Errata\""; } push @body, "
"; push @body, "Expand"; push @body, ""; push @body, "Brief"; 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, ""; push @body, ""; push @body, "
You can order this item by clicking the order icon"; push @body, "\"Order"; if(stat("$options{errata}/@{$item}[1]")) { push @body, "\"Errata\""; } 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, ""; if($options{brief}) { push @body, ""; $style = "brief"; } else { push @body, ""; $style = "full"; } push @body, "
"; push @body, "

@{$item}[1] $filler

"; push @body, "\"Order"; if(stat("$options{errata}/@{$item}[1]")) { push @body, "\"Errata\""; } push @body, "
"; push @body, "Expand"; push @body, ""; push @body, "Brief"; 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, ""; push @body, ""; push @body, "
You can order this item by clicking the order icon"; push @body, "\"Order"; if(stat("$options{errata}/@{$item}[1]")) { push @body, "\"Errata\""; } 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, ""; push @body, ""; push @body, "
$file
"; # 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, "
"; push @body, "
";
			push @body, LabelDesc($fullpath, $label, $options{brief});
			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, ""; foreach $name (@nameList) { $type = FileType($name, $extList); push @body, ""; } push @body, "
  

Files

 
$name ($type)
"; # 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, "
"; push @body, ""; push @body, ""; push @body, ""; push @body, "Your name :
"; push @body, "Your e-mail:
"; push @body, "Shipping Instructions:
"; push @body, "
"; push @body, "
       ";
	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, ""; push @body, ""; push @body, ""; # @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, ""; push @body, ""; push @body, ""; } push @body, "
VolumeLast updateChanged Recently
$line$update"; if($now - $info[9] < 2592000) { # 30 days push @body, "X"; } else { } 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, ""
 		             }
 		             push @body, "";
 		             push @body, "";
 		             $errataFound = 1;
 		         }
 		      }
 		      if($errataFound) { push @body, "
Sub-volumes:
   $line
"; } } 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(