#!/usr/common/bin/perl


############################################################################
############################################################################
### REF                                                                  ###
############################################################################
### A `CBR-lite' System for the Retrieval of Bibliographical Information ###
############################################################################
### Written by Andrew Broad, (C) BROADSOFT 1997                          ###
############################################################################
### Program: ref                                                         ###
############################################################################
### Command Line Arguments:-                                             ###
###     0: the Filename of the Bibliographical Case Base (optional)      ###
############################################################################
############################################################################


##########################################################################
# If you are not me, modify $path to the directory in which              #
# you are using ref (or wherever you want the input to be read from      #
# and the output written to)                                             #
# It must be an absolute path in UNIX and the / on the end is obligatory #                  
##########################################################################

$path = "/home/broada/REF/";


##################
## Main Program ##
##################

##################
# Load Case Base #
##################

$filename= $ARGC ? $ARGV[0] : $path . "biblio";

open(LIBRARY, $filename);

print "Reading case base from \"$filename\"...\n";

while ($lineno++, $line= <LIBRARY>) {
	if ($line =~ /\{/) {
		@snippet_queue= ();
		push @library, ($parent= read_case());
		############################################
		# Insert snippets from the snippet queue   #
		# into the case library after their parent #
		# with a backpointer ("In") to that case   #
		############################################
		foreach $snippet (@snippet_queue) {
			push @library, $snippet;
			$$snippet{"In"}= $parent;
		}
	}
}

close(LIBRARY);

#############################
# Input query (target case) #
#############################

%indexes = (
	"Type"    => "SCALAR",
	"Degree"  => "SCALAR",
	"Course"  => "SCALAR",
	"Title"   => "SCALAR",
	"Authors" => "LIST",
	"Date"    => "SCALAR",
	"Status"  => "SCALAR",
	"Cited"   => "LIST",
	"Keyword" => "LIST"
);

foreach $index (keys %indexes) {
	undef $target{$index};
}

$done= 0;
while ($done == 0) {
	print chr 12; # CLS
	print "------------\nTarget Query\n------------\n\n";
	foreach $feature (sort keys %target) {
		print "$feature\t= ";
		if (not defined $target{$feature}) {
			print "UNSPECIFIED\n";
		} elsif (not ref $target{$feature}) {
			print "${target{$feature}}\n";
		} else {
			print '[';
			$count= 0;
			foreach $entry (@{$target{$feature}}) {
				if ($count++ > 0) {
					print ',';
				}
				print "$entry";
			}
			print "]\n";
		}
	}
	print "\n\n";
foo:	print <<END;
Please enter a dimension for which you wish to specify a value
(e.g. "Type"), otherwise just press Return to do the retrieval.
END
	print '-> ';
	$attr= <STDIN>;
	last if ($attr eq "\n");

	chop $attr;
	if (not exists $indexes{$attr}) {
		print "That isn't a valid index dimension, you stupid human!\a\n\n";
		goto foo;
	}
	if ($indexes{$attr} eq "LIST") {
		print <<END;
Please enter a list of items, separated and terminated by newlines:
END
		while (($entry= <STDIN>) ne "\n") {
			chop $entry;
			push @list,$entry;
		}
		$target{$attr}= [@list];
		@list= ();
	} else {
		print "Please enter a value:\n-> ";
		$value= <STDIN>;
		chop $value;
		$target{$attr}= $value;
	}
}

####################
# Clear the screen #
####################

print chr 12;

#######################################
# Retrieve matching cases from memory #
#######################################

print "Doing retrieval...\n\n";

foreach $case (@library) {
	$score= sim($case);
	if ($score > 0) {
		$$case{"MatchScore"}= $score;
		push @rankings, $case;
	}
}

print scalar(@rankings);
print " cases match the target query.\n";

if (@rankings == 0) {
	exit;
}

#####################################################
# Rank the retrieved cases by match score           #
# (using first author and then date as tiebreakers) #
#####################################################

@rankings= sort {
	-$$a{"MatchScore"} <=> -$$b{"MatchScore"}
	or tiebreak($a,$b)
} @rankings;

##########################################################
# Output retrieved cases as references in a bibliography #
##########################################################

print "\nGenerating \"ref-output.html\"...\n\n";
open(OUTPUT, ">" . $path . "ref-output.html");
print OUTPUT "<HTML><TITLE>REF output</TITLE>\n";
print OUTPUT "<H1>REF output<BR></H1>\n\n";

$ranking= 1;
foreach $case (@rankings) {
	print OUTPUT "\n[$ranking]";
	generate_html($case);
	print OUTPUT '.';

	#######
	# URL #
	#######
	if (exists $$case{"URL"}) {
		print OUTPUT " On the Internet at <A href=$$case{\"URL\"}>$$case{\"URL\"}</A>";
		if (exists $$case{"LastModified"}) {
			print OUTPUT " (last modified $$case{\"LastModified\"})";
		} else {
			print "\aWarning: this Internet reference has no last-modified date!\n";
			print_case($case);
		}		
		print OUTPUT '.';
	}

	print OUTPUT "<BR><B>\n";

	#################################
	# Match Score (as a percentage) #
	#################################
	$match_score= $$case{"MatchScore"} * 100;
	print OUTPUT "<LI>Match Score: $match_score%<BR>\n";

	############
	# Keywords #
	############
	if (exists $$case{"Keyword"} and @{$$case{"Keyword"}} > 0) {
		print OUTPUT "<LI>Keywords: ";
		if (exists $$case{"In"} and exists $$case{"In"}{"Keyword"}) {
			for ($i= 0; $i < @{$$case{"In"}{"Keyword"}}; $i++) {
				print OUTPUT ${$$case{"In"}{"Keyword"}}[$i];
				print OUTPUT ', ';
			}
		}
		for ($i= 0; $i < @{$$case{"Keyword"}}; $i++) {
			print OUTPUT ${$$case{"Keyword"}}[$i];
			if ($i < @{$$case{"Keyword"}}-1) {
				print OUTPUT ', ';
			}
		}
		print OUTPUT "<BR>\n";
	} elsif ($$case{"Type"} eq "ARTICLE") {
		print "\aWarning: this article has no keywords!\n";
		print_case($case);
	}
	#########
	# Cited #
	#########
	if (exists $$case{"Cited"} and @{$$case{"Cited"}} > 0) {
		print OUTPUT "<LI>Cited in";
		for ($i= 0; $i < @{$$case{"Cited"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Cited"}}[$i];
			if ($i == @{$$case{"Cited"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Cited"}}-2) {
				print OUTPUT ',';
			}
		}
		print OUTPUT ".<BR>\n";
	}
	##########
	# Status #
	##########
	if (exists $$case{"Status"}) {
		print OUTPUT "<LI>$$case{\"Status\"}<BR>\n";
	} elsif (exists $$case{"In"} and exists $$case{"In"}{"Status"}) {
		print OUTPUT "<LI>$$case{\"In\"}{\"Status\"}<BR>\n";
	}
	############
	# Notebook #
	############
	if (exists $$case{"Notebook"}) {
		print OUTPUT "<LI>See Notebook, $$case{\"Notebook\"}.<BR>\n";
	}

	print OUTPUT "</B><P>\n";
	$ranking++;
}

print OUTPUT "</HTML>\n";
close(OUTPUT);

#############################################
## Subroutine: read_case                   ##
#############################################
## Subroutine to read a case from the file ##
## (the `{' having already been consumed)  ##
## POST: $line contains `}', whole case    ##
##       has been consumed from the file   ##
## - Returns a reference to a hash         ##
##   representing the case                 ##
#############################################

sub read_case {
	my (%hash);
	while ($lineno++, $line= <LIBRARY> and $line !~ s/\}//) {
		$_= $line;
		chop;

		########################################
		# Dig out attribute as $1, value as $2 #
		########################################
		if (/\s*([A-Za-z]+)\s*=\s*(.+)$/) {
			my ($attr)= $1;
			$line= $2;

			#####################################
			# If value is a list                #
			# then read that list from the file #
			#####################################
			if ($line =~ s/\[//) {
				$hash{$attr}= read_list();

			######################################
			# Otherwise (if value is not a list) #
			# treat it as a `normal' attribute   #
			######################################
			} else {
				$hash{$attr}= read_nonlist_value();
			}
		} else {
			die "\aSyntax error detected at line $lineno of \"$ARGV[0]\"\n";
		}
	}
	return \%hash;
}


#######################################################
## Subroutine: read_list                             ##
#######################################################
## Subroutine to read a list from the file           ##
## (the `[' having already been consumed)            ##
## PRE: $line holds the first line of the list,      ##
##      the others are next to be read from the file ##
## POST: $line holds the last line of the list,      ##
##       whole list has been consumed from file      ##
## - Returns a reference to the list.                ##
#######################################################

sub read_list {
	my (@list);
	my ($last);
	$last= 0;
	while ($last == 0) {

		######################################
		# Watch out for the end of the list! #
		######################################
		if ($line =~ s/]//) {
			$last= 1;
		}

		############################
		# Strip leading whitespace #
		############################
		$line =~ s/\s*//;

		############################################
		# Read a non-list value from the file and, #
		# providing it isn't the empty string,     #
		# insert it in the list                    #
		############################################
		if (($entry= read_nonlist_value()) ne "") {
			push @list, $entry;
		}

		##############################################
		# Watch out for the end of the list - again! #
		##############################################
		if ($line =~ s/]//) {
			$last= 1;
		}

		############################################
		# Read the next line from the file         #
		# if we haven't got to the end of the list #
		############################################
		if ($last == 0) {
			$lineno++, $line= <LIBRARY>;
			chop $line;
		}
	}
	return \@list;
}


#######################################################
## Subroutine: read_nonlist_value                    ##
#######################################################
## Subroutine to read a non-list value from the file ##
## (which could itself be a case-snippet)            ##
## PRE: $line holds the first line of the value,     ##
##      the others are next to be read from the file ##
## - Returns the attribute (either a scalar or a     ##
##   reference to a hash representing a snippet)     ##
#######################################################

sub read_nonlist_value {
	my ($value);
	if ($line =~ /\{/) {
		$value= read_case();
		#######################################
		# Snippet waits in the snippet queue  #
		# so that it can be inserted into the #
		# case library after its parent       #
		#######################################
		push @snippet_queue, $value;
	} else {
		$value= $line;
	}
	return $value;
}


#########################################################################
## Subroutine: sim                                                     ##
#########################################################################
## The Similarity Metric                                               ##
## - Takes as input a reference to a source case                       ##
## - Returns the degree of match of the source case to the target case ##
##   on a scale 0 (no match) to 1 (perfect match)                      ##
#########################################################################

sub sim {
	my $s= shift;
	my $t= \%target;
	my $score= 0;
	my $out_of= 0;

	#############################################
	# Compare each dimension in target case     #
	# to corresponding dimension in source case #
	#############################################

	foreach $dimension (keys %$t) {
		if (defined $$t{$dimension}) {
			if (not ref($$t{$dimension})) {
				###################
				# Compare scalars #
				###################
				if (exists $$s{$dimension}) {
					$score+= scalar_match($$s{$dimension}, $$t{$dimension}, $s);
				} else {
					##################################
					# Attribute isn't in source case #
					# so look in parent case         #
					# if this is a snippet           #
					##################################
					if (exists $$s{"In"}
					and exists $$s{"In"}{$dimension}) {
						$score+= scalar_match($$s{"In"}{$dimension}, $$t{$dimension}, $s);
					}
				}
				$out_of++;
			} else {
				#################
				# Compare lists #
				#################
				if (exists $$s{$dimension}) {
					$score+= list_match($$s{$dimension}, $$t{$dimension}, $s);
				} else {
					##################################
					# Attribute isn't in source case #
					# so look in parent case         #
					# if this is a snippet           #
					##################################
					if (exists $$s{"In"}
					and exists $$s{"In"}{$dimension}) {
						$score+= list_match($$s{"In"}{$dimension}, $$t{$dimension}, $s);
					}
				
				}
				$out_of+= @{$$t{$dimension}};
			}
		}
	}

	if ($out_of > 0) {
		####################################################
		# Return match score, normalized to a real number  #
		# between 0 (total mismatch) and 1 (perfect match) #
		####################################################
		return ($score / $out_of);
	} else {
		#####################################
		# Blank query gives perfect matches #
		#####################################
		return 1;
	}
}


#############################################################
## Subroutine: scalar_match                                ##
#############################################################
## Test whether a source string matches a target string    ##
## - First argument is the source string                   ##
## - Second argument is the target string                  ##
## - Third argument is a reference to the source case      ##
## - Returns whether the strings match (i.e. if either one ##
## is a substring of the other, for our putposes)          ##
#############################################################

sub scalar_match {
	my ($svalue, $tvalue, $s)= @_;

	if (not ref($svalue)) {
		######################################
		# Ignore non-alphanumeric characters #
		######################################
		$svalue=~ s/[^a-zA-Z0-9]+//g;
		$tvalue=~ s/[^a-zA-Z0-9]+//g;

		#######################################
		# Source string matches target string #
		# (case-insensitive)                  #
		# if source is substring of target    #
		# and vice versa (0.5 marks)          #
		#######################################
		return (($svalue =~ /$tvalue/i) or ($tvalue =~ /$svalue/i));
	} else {
		####################################
		# French plug in an English socket #
		####################################
		print chr 12; # CLS
		print "Type mismatch in the following source case...\n\n";
		print_case($s);
		print "...was expecting [@$svalue] to be a scalar!\n\nDied";
		die "\a";
	}
}


##########################################################
## Subroutine: list_match                               ##
##########################################################
## Match list from source case to list from target case ##
## - First argument is the source list                  ##
## - Second argument is the target list                 ##
## - Third argument is a reference to the source case   ##
##########################################################

sub list_match {
	my ($source_list, $target_list, $s)= @_;
	my $score= 0;
	my ($scored, $dscore);

	if (ref($source_list) eq "ARRAY") {
		#######################################################
		# One mark for each entry in the target list          #
		# that matches some entry in the source list (at all, #
		# doesn't keep looking for a better match)            #
		#######################################################
		foreach $target_entry (@$target_list) {
			$scored= 0;
LABEL:			foreach $source_entry (@$source_list) {
				$dscore= scalar_match($source_entry,$target_entry,$s);
				if ($dscore > 0) {
					$score+= $dscore; $scored= 1;
					last LABEL;
				}
			}
			############################################
			# If source entry isn't found in a snippet #
			# then look in the parent case             #
			############################################
			if (not $scored and exists $$s{"In"} 
		         	        and exists $$s{"In"}{$dimension}
			                and ref($$s{"In"}{$dimension}) eq "ARRAY") {
LABEL2:				foreach $source_entry (@{$$s{"In"}{$dimension}}) {
					$dscore= scalar_match($source_entry, $target_entry, $s);
					if ($dscore > 0) {
						$score+= $dscore;
						last LABEL2;
					}
				}
			}
		}
	} else {
		###################################
		# English plug in a French socket #
		###################################
		print chr 12;
		print "Type mismatch in the following source case...\n\n";
		print_case($s);
		print "...was expecting \"$source_list\" to be a list!\n\nDied";
		die "\a";
	}
	return $score;
}


###################################################################
## Subroutine: tiebreak                                          ##
###################################################################
## Subroutine to compare the authors (or editors) of a reference ##
## - First argument is a reference to the source case            ##
## - Second argument is a reference to the target case           ##
## - Returns -1 if the author of the source is before the author ##
##              of the target in the alphabet                    ##
##            0 if the authors are equal                         ##
##            1 if the author of the source is after the author  ##
##              of the target in the alphabet                    ##
## Uses date as second tiebreaker                                ##
###################################################################

sub tiebreak {
	my ($s, $t)= @_;
	my ($sauthors, $tauthors); $sauthors= []; $tauthors= [];
	my ($sauthor, $tauthor, $sdate, $tdate, $cmp);

	##########################################
	# First tiebreaker: Authors/Editors/Sort #
	##########################################
	if (exists $$s{"Authors"}) {
		$sauthors= $$s{"Authors"};
	} elsif (exists $$s{"Editors"}) {
		$sauthors= $$s{"Editors"};
	} elsif (exists $$s{"Sort"}) {
		$sauthors= $$s{"Sort"};
	} else {
		print "Fatal error: neither \"Authors\", \"Editors\" nor \"Sort\" exists in:-";
		print_case($s);
		die "\a\n";
	}
	if (exists $$t{"Authors"}) {
		$tauthors= $$t{"Authors"};
	} elsif (exists $$t{"Editors"}) {
		$tauthors= $$t{"Editors"};
	} elsif (exists $$t{"Sort"}) {
		$tauthors= $$t{"Sort"};
	} else {
		print "Fatal error: neither \"Authors\", \"Editors\" nor \"Sort\" exists in:-";
		print_case($t);
		die "\a\n";
	}
	for ($i= 0; $i < (@$sauthors > @$tauthors ? @$tauthors : @$sauthors); $i++) {
		$sauthor= $$sauthors[$i]; $sauthor=~ s/([ A-Za-z-']+)/$1/; $sauthor= $1;
		$tauthor= $$tauthors[$i]; $tauthor=~ s/([ A-Za-z-']+)/$1/; $tauthor= $1;
		$cmp= $sauthor cmp $tauthor;
		return $cmp if $cmp;
	}
	$cmp= @$sauthors <=> @$tauthors;
	return $cmp if $cmp;

	###########################
	# Second tiebreaker: Date #
	###########################
	if (exists($$s{"Date"})) {
		$sdate= $$s{"Date"};
	} elsif (exists($$s{"In"}) and exists($$s{"In"}{"Date"})) {
		$sdate= $$s{"In"}{"Date"};
	} elsif (exists($$s{"LastModified"})) {
		$$s{"LastModified"} =~ /([0-9]{4})/; $sdate= $1 + 0.99;
	} else {
		print "Fatal error: \"Date\" does not exist in:-";
		print_case($s);
		die "\a\n";
	}
	$sdate= 9999 if $sdate eq "unpublished";

	if (exists($$t{"Date"})) {
		$tdate= $$t{"Date"};
	} elsif (exists($$t{"In"}) and exists($$t{"In"}{"Date"})) {
		$tdate= $$t{"In"}{"Date"};
	} elsif (exists($$t{"LastModified"})) {
		$$t{"LastModified"} =~ /([0-9]{4})/; $tdate= $1 + 0.99;
	} else {
		print "Fatal error: \"Date\" does not exist in:-";
		print_case($t);
		die "\a\n";
	}
	$tdate= 9999 if $tdate eq "unpublished";

	return $sdate <=> $tdate;
}

##################################################################
## Subroutine: print_case                                       ##
##################################################################
## Subroutine to print a case (not pretty!)                     ##
## Prints lines in the format "Attribute = Value" in hash order ##
## - Argument is a reference to the case to be printed          ##
##################################################################

sub print_case {
	my $case= shift;

	foreach $feature (keys %$case) {
		print $feature;
		print ' = ';
		$value= $$case{$feature};
		if (ref($value) eq "ARRAY") {
			print '[';
			$count= 0;
			foreach $entry (@$value) {
				if ($count++ > 0) {
					print ',';
				}
				print "$entry";
			}
			print "]";
		} else {
			print $value;
		}
		print "\n";
	}
	print "\n";
}


##########################################################
## Subroutine: generate_html                            ##
##########################################################
## Subroutine to write an entry for a given reference   ##
## to the HTML file                                     ##
## - Argument is the case for the reference in question ##
##########################################################

sub generate_html {
	$type= $$case{"Type"};
	if ($type eq "AUTHORED BOOK" or $type eq "EDITED BOOK") {
		book($case);
	} elsif ($type eq "TECHNICAL REPORT" or $type eq "THESIS" or $type eq "DISSERTATION" or $type eq "PROJECT REPORT" or $type eq "ESSAY" or $type eq "UNPUBLISHED PAPER" or $type eq "HANDOUT" or $type eq "LECTURE NOTES") {
		report($case);
	} elsif ($type eq "PROCEEDINGS") {
		proceedings($case);
	} elsif ($type eq "JOURNAL") {
		journal($case);
	} elsif ($type eq "ARTICLE") {
		article($case);
	} elsif ($type eq "INTERNET") {
		internet($case);
	} else {
		print "\aI'm afraid I don't know about \L${type}s!\n";
		print_case($case);
	}
}


################################################################
## Subroutine: book                                           ##
################################################################ 
## Subroutine to write an entry for a book to the HTML file   ##                                ## - First argument is the case for the reference in question ##
## - Second argument (optional) is to suppress the date       ##
################################################################

sub book {
	my ($case)= shift;
	my ($int_date);

	###################
	# Authors/Editors #
	###################
	if (exists $$case{"Authors"} and @{$$case{"Authors"}} > 0) {
		for ($i= 0; $i < @{$$case{"Authors"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Authors"}}[$i];
			if ($i == @{$$case{"Authors"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Authors"}}-2) {
				print OUTPUT ',';
			}
		}
	} elsif (exists $$case{"Editors"} and @{$$case{"Editors"}} > 0) {
		for ($i= 0; $i < @{$$case{"Editors"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Editors"}}[$i];
			if ($i == @{$$case{"Editors"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Editors"}}-2) {
				print OUTPUT ',';
			}
		}
		print OUTPUT ', editor';
		if (@{$$case{"Editors"}} > 1) {
			print OUTPUT 's';
		}
		print OUTPUT '.';
	} else {
		print "\aWarning: this book has no authors or editors!\n";
		print_case($case);
	}
	########
	# Date #
	########
	if (exists $$case{"Date"}) {
		$int_date= int($$case{"Date"});
		print OUTPUT " ($int_date)." if (not @_);
	} else {
		print "\aWarning: this book has no date!\n";
		print_case($case);
	}
	#########
	# Title #
	#########
	if (exists $$case{"Title"}) {
		print OUTPUT " <CITE>$$case{\"Title\"}</CITE>";
	} else {
		print "\aWarning: this book has no title!\n";
		print_case($case);
	}
	######################
	# Edition (optional) #
	######################
	if (exists $$case{"Edition"}) {
		print OUTPUT ", $$case{\"Edition\"} Edition";
	}
	#############
	# Publisher #
	#############
	if (exists $$case{"Publisher"}) {
		print OUTPUT ". $$case{\"Publisher\"}";
	} else {
		print "\aWarning: this book has no publisher!\n";
		print_case($case);
	}
	#######################
	# City of publication #
	#######################
	if (exists $$case{"City"}) {
		print OUTPUT ", $$case{\"City\"}";
	} else {
		print "\aWarning: this book has no city of publication!\n";
		print_case($case);
	}
	########
	# ISBN #
	########
	if (exists $$case{"ISBN"}) {
		print OUTPUT ". ISBN $$case{\"ISBN\"}";
	} else {
		print "\aWarning: this book has no ISBN!\n";
		print_case($case);
	}
}


##############################################################################
## Subroutine: proceedings                                                  ##
##############################################################################
## Subroutine to write an entry for conference proceedings to the HTML file ##                                ## - First argument is the case for the reference in question               ##
## - Second argument (optional) is to suppress the date                     ##
##############################################################################

sub proceedings {
	my ($case)= shift;
	my ($int_date);

	###########
	# Editors #
	###########
	if (exists $$case{"Editors"} and @{$$case{"Editors"}} > 0) {
		for ($i= 0; $i < @{$$case{"Editors"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Editors"}}[$i];
			if ($i == @{$$case{"Editors"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Editors"}}-2) {
				print OUTPUT ',';
			}
		}
		print OUTPUT ', editor';
		if (@{$$case{"Editors"}} > 1) {
			print OUTPUT 's';
		}
		print OUTPUT '.';
	}
	########
	# Date #
	########
	if (exists $$case{"Editors"} and exists $$case{"Date"}) {
		$int_date= int($$case{"Date"});
		print OUTPUT " ($int_date)." if (not @_);
	}
	#########
	# Title #
	#########
	if (exists $$case{"Title"}) {
		print OUTPUT " <CITE>$$case{\"Title\"}</CITE>";
	} else {
		print "\aWarning: these proceedings have no title!\n";
		print_case($case);
	}
	#########
	# Venue #
	#########
	if (exists $$case{"Venue"}) {
		print OUTPUT ", $$case{\"Venue\"}";
	} else {
		print "\aWarning: these proceedings have no venue!\n";
		print_case($case);
	}
	#########
	# Dates #
	#########
	if (exists $$case{"Dates"}) {
		print OUTPUT ", $$case{\"Dates\"}";
	} else {
		print "\aWarning: these proceedings have no dates!\n";
		print_case($case);
	}
	#################
	# Volume number #
	#################
	if (exists $$case{"LNCS"}) {
		print OUTPUT ". Lecture Notes in Computer Science $$case{\"LNCS\"}";
	} elsif (exists $$case{"Volume"}) {
		print OUTPUT ". Volume $$case{\"Volume\"}";
	}
	#############
	# Publisher #
	#############
	if (exists $$case{"Publisher"}) {
		print OUTPUT ". $$case{\"Publisher\"}";
	}
	#######################
	# City of publication #
	#######################
	if (exists $$case{"City"}) {
		print OUTPUT ", $$case{\"City\"}";
	}
	########
	# ISBN #
	########
	if (exists $$case{"ISBN"}) {
		print OUTPUT ". ISBN $$case{\"ISBN\"}";
	}
	##################################################
	# Journal (e.g. for ACM Special Interest Groups) #
	##################################################
	if (exists $$case{"Journal"}) {
		print OUTPUT ". <CITE>$$case{\"Journal\"}</CITE>";
		if (exists $$case{"VolumeNumber"}) {
			print OUTPUT " $$case{\"VolumeNumber\"}";
		} else {
			print "Warning: this journal has no volume number!\n";
			print_case($case);
		}
		if (exists $$case{"IssueNumber"}) {
			print OUTPUT "($$case{\"IssueNumber\"})";
		} else {
			print "Warning: this journal has no issue number!\n";
			print_case($case);
		}
		if (exists $$case{"Date"}) {
			$int_date= int($$case{"Date"});
			print OUTPUT ', ';
			if (exists $$case{"Month"}) {
				print OUTPUT " $$case{\"Month\"}";
			} else {
				print "Warning: this journal has no month!\n";
				print_case($case);
			}
			print OUTPUT " $int_date";
		} else {
			print "Warning: this journal has no year!\n";
			print_case($case);
		}
	}
}


#################################################################
## Subroutine: journal                                         ##
#################################################################
## Subroutine to write an entry for a journal to the HTML file ##                                ## - First argument is the case for the reference in question  ##
## - Second argument (optional) is to suppress the date        ##
#################################################################

sub journal {
	my ($case)= shift;
	my ($int_date);

	#########
	# Title #
	#########
	if (exists $$case{"Title"}) {
		print OUTPUT " <CITE>$$case{\"Title\"}</CITE>";
	} else {
		print "\aWarning: this journal has no title!\n";
		print_case($case);
	}
	#################
	# Volume number #
	#################
	if (exists $$case{"VolumeNumber"}) {
		print OUTPUT " $$case{\"VolumeNumber\"}";
	} else {
		print "\aWarning: this journal has no volume number!\n";
		print_case($case);
	}
	################
	# Issue number #
	################
	if (exists $$case{"IssueNumber"}) {
		print OUTPUT "($$case{\"IssueNumber\"})";
	}
	########
	# Date #
	########
	if (exists $$case{"Date"} and exists $$case{"Month"}) {
		$int_date= int($$case{"Date"});
		print OUTPUT ', ';
		print OUTPUT " $$case{\"Month\"}";
		print OUTPUT " $int_date";
	}
}


###################################################################
## Subroutine: report                                            ##
###################################################################
## Subroutine to write an entry for a technical report, handout, ##
## thesis, project report or essay to the HTML file              ##
## - Argument is the case for the reference in question          ##
###################################################################

sub report {
	my ($case)= shift;
	my ($int_date);

	###########
	# Authors #
	###########
	if (exists $$case{"Authors"} and @{$$case{"Authors"}} > 0) {
		for ($i= 0; $i < @{$$case{"Authors"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Authors"}}[$i];
			if ($i == @{$$case{"Authors"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Authors"}}-2) {
				print OUTPUT ',';
			}
		}
	} else {
		print "\aWarning: this report has no authors!\n";
		print_case($case);
	}
	########
	# Date #
	########
	if (exists $$case{"Date"}) {
		if ($$case{"Date"} ne "unpublished") {
			$int_date= int($$case{"Date"});
		} else {
			$int_date= "unpublished";
		}
		############################################
		# "You don't have to memorise all the code #
		#  unless you have a photographic memory   #
		#  and no intelligence, in which case      #
		#  you had better memorise the code."      #
		# (Chris Kirkham in 1996/7 CS3112)         #
		############################################
		print OUTPUT " ($int_date)";
	} else {
		print "\aWarning: this report has no date!\n";
		print_case($case);
	}
	#################
	# Lecture notes #
	#################
	if ($$case{"Type"} eq "LECTURE NOTES") {
		print OUTPUT ". Lecture Notes for ";
		if (exists $$case{"Course"}) {
			print OUTPUT "$$case{\"Course\"}";
		} else {
			print "\aWarning: these lecture notes have no course code!\n";
			print_case($case);
		}
	}
	#########
	# Title #
	#########
	if (exists $$case{"Title"}) {
		if ($$case{"Type"} eq "LECTURE NOTES") {
			print OUTPUT ": $$case{\"Title\"}";
		} else {
			print OUTPUT ". $$case{\"Title\"}";
		}
		if ($$case{"Date"} ne "unpublished") {
			print OUTPUT '.';
		}		
	} else {
		print "\aWarning: this report has no title!\n";
		print_case($case);
	}
	######################################
	# Theses, project reports and essays #
	######################################
	if (exists $$case{"Degree"}) {
		print OUTPUT " $$case{\"Degree\"}";
	} elsif ($$case{"Type"} eq "THESIS" or $$case{"Type"} eq "DISSERTATION") {
		print "\aWarning: this thesis has no degree associated with it!\n";
		print_case($case);
	} elsif (exists $$case{"Course"} and $$case{"Type"} ne "HANDOUT" and $$case{"Type"} ne "LECTURE NOTES") {
		print OUTPUT " $$case{\"Course\"}";
	} elsif ($$case{"Type"} eq "PROJECT REPORT" or $$case{"Type"} eq "ESSAY") {
		print "\aWarning: this assignment has no course associated with it!\n";
		print_case($case);
	}
	if ($$case{"Type"} eq "THESIS") {
		print OUTPUT " thesis,";
	} elsif ($$case{"Type"} eq "DISSERTATION") {
		print OUTPUT " dissertation,";
	} elsif ($$case{"Type"} eq "PROJECT REPORT") {
		print OUTPUT " project report,";
	} elsif ($$case{"Type"} eq "ESSAY") {
		print OUTPUT " essay,";
	}
	############
	# Handouts #
	############
	if ($$case{"Type"} eq "HANDOUT") {
		if (exists $$case{"Course"}) {
			print OUTPUT " Handout for $$case{\"Course\"},";
		} else {
			print "\aWarning: this handout has no course associated with it!\n";
			print_case($case);
		}
	}
	###############
	# Institution #
	###############
	if (exists $$case{"Institution"}) {
		print OUTPUT " $$case{\"Institution\"}";
	} elsif ($$case{"Type"} ne "UNPUBLISHED PAPER") {
		print "\aWarning: this report has no institution!\n";
		print_case($case);
	}
	#################
	# Report number #
	#################
	if (exists $$case{"ReportNumber"}) {
		print OUTPUT ", technical report $$case{\"ReportNumber\"}";
	} elsif ($$case{"Type"} eq "TECHNICAL REPORT") {
		print "\aWarning: this report has no number!\n";
		print_case($case);
	}
}


##################################################################
## Subroutine: article                                          ##
##################################################################
## Subroutine to write an entry for an article to the HTML file ##                                ## - First argument is the case for the reference in question   ##
##################################################################

sub article {
	my ($case)= shift;
	my ($int_date);

	###########
	# Authors #
	###########
	if (exists $$case{"Authors"} and @{$$case{"Authors"}} > 0) {
		for ($i= 0; $i < @{$$case{"Authors"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Authors"}}[$i];
			if ($i == @{$$case{"Authors"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Authors"}}-2) {
				print OUTPUT ',';
			}
		}
	} else {
		print "\aWarning: this article has no authors!\n";
		print_case($case);
	}
	########
	# Date #
	########
	if (exists $$case{"In"} and exists $$case{"In"}{"Date"}) {
		$int_date= int($$case{"In"}{"Date"});
		print OUTPUT " ($int_date).";
	} else {
		print "\aWarning: this article has no date!\n";
		print_case($case);
	}
	#########
	# Title #
	#########
	if (exists $$case{"Title"}) {
		print OUTPUT " $$case{\"Title\"}. ";
	} else {
		print "\aWarning: this article has no title!\n";
		print_case($case);
	}
	#############
	# Page-span #
	#############
	print OUTPUT 'Pages ' if (exists $$case{"BeginPage"} or exists $$case{"EndinPage"});
	if (exists $$case{"BeginPage"}) {
		print OUTPUT "$$case{\"BeginPage\"}";
	} else {
		print "\aWarning: this article has no beginning page number!\n";
		print_case($case);
	}
	print OUTPUT '-' if (exists $$case{"BeginPage"} or exists $$case{"EndinPage"});
	if (exists $$case{"EndinPage"}) {
		print OUTPUT "$$case{\"EndinPage\"}";
	} else {
		print "\aWarning: this article has no ending page number!\n";
		print_case($case);
	}
	######
	# In #
	######
	if (exists $$case{"In"}) {
		my ($parent_type)= $$case{"In"}{"Type"};
		if (exists $$case{"BeginPage"} or exists $$case{"EndinPage"}) {
			print OUTPUT ' in';
		} else {
			print OUTPUT ' In';
		}
		if ($parent_type eq "EDITED BOOK") {
			book($$case{"In"}, "suppress date");
		} elsif ($parent_type eq "PROCEEDINGS") {
			proceedings($$case{"In"}, "suppress date");
		} elsif ($parent_type eq "JOURNAL") {
			journal($$case{"In"}, "suppress date");
		} else {
			print "\aI'm afraid I don't know about \L${parent_type}s!\n";
			print_case($$case{"In"});
		}
	} else {
		print "\aWarning: this article isn't in anything!\n";
		print_case($case);
	}
}


############################################################
## Subroutine: internet                                   ##
############################################################
## Subroutine to write an entry for an internet reference ##
## to the HTML file                                       ##
## - Argument is the case for the reference in question   ##
############################################################

sub internet {
	my ($case)= shift;
	my ($int_date);

	###########
	# Authors #
	###########
	if (exists $$case{"Authors"} and @{$$case{"Authors"}} > 0) {
		for ($i= 0; $i < @{$$case{"Authors"}}; $i++) {
			print OUTPUT ' ';
			print OUTPUT @{$$case{"Authors"}}[$i];
			if ($i == @{$$case{"Authors"}}-2) {
				print OUTPUT ' and';
			} elsif ($i < @{$$case{"Authors"}}-2) {
				print OUTPUT ',';
			}
		}
	} else {
		print "\aWarning: this web page has no authors!\n";
		print_case($case);
	}
	###############
	# Institution #
	###############
	if (exists $$case{"Institution"}) {
		print OUTPUT ", $$case{\"Institution\"}";
	}
	#########
	# Title #
	#########
	if (exists $$case{"Title"}) {
		print OUTPUT ". <CITE>$$case{\"Title\"}</CITE>";
	} else {
		print "\aWarning: this web page has no title!\n";
		print_case($case);
	}
}
