Index: /trunk/gsdl/bin/script/indexes/Core.pm
===================================================================
--- /trunk/gsdl/bin/script/indexes/Core.pm	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/Core.pm	(revision 1971)
@@ -0,0 +1,895 @@
+#
+# PDF::Core.pm, version 1.11 February 2000 antro
+#
+# Copyright (c) 1998 - 2000 Antonio Rosella Italy antro@tiscalinet.it, Johannes Blach dw235@yahoo.com 
+#
+# Free usage under the same Perl Licence condition.
+#
+
+package PDF::Core;
+
+$PDF::Core::VERSION = "1.11";
+
+=pod
+
+=head1 NAME
+
+PDF::Core - Core Library for PDF library
+
+=head1 SYNOPSIS
+
+  use PDF::Core;
+
+  $pdf=PDF::Core->new ;
+  $pdf=PDF->new(filename);
+
+  $res= $pdf->GetObject($ref);
+
+  $name = UnQuoteName($pdfname);							  
+  $string = UnQuoteString($pdfstring);							  
+
+  $pdfname = QuoteName($name);							  
+  $pdfhexstring = QuoteHexString($string);
+  $pdfstring = QuoteString($string);
+
+  $obj = PDFGetPrimitive (filehandle, \$offset);
+  $line = PDFGetLine (filehandle, \$offset);
+  
+
+=head1 DESCRIPTION
+
+The main purpose of the PDF::Core library is to provide the data structure
+and the constructor for the more general PDF library.
+
+=cut
+
+require 5.005;
+use strict;
+use Carp;
+use Exporter ();
+
+use vars qw(@ISA @EXPORT_OK $UseObjectCache);
+
+@ISA = qw(Exporter);
+
+@EXPORT_OK = qw( GetObject );
+
+#
+# Object caching
+#
+# If this variable is true, all processed objects will be added to the
+# object cache. If only header information of a PDF are read or very
+# big PDF are processed, turning off the cache reduces the memory usage.
+#
+$UseObjectCache = 1;
+
+
+#################################################################
+#
+# Helper functions
+#
+#################################################################
+
+=pod
+
+=head1 Helper functions
+
+This functions are not part of the class, but perform useful services.
+
+=cut
+
+#
+# Modification by johi: 18.12.1999
+#
+
+#################################################################
+=pod
+
+=head2 UnQuoteName ( string )
+
+This function processes quoted characters in a PDF-name. PDF-names returned by
+B<GetObject> are already processed by this function.
+
+Returns a string.
+
+=cut
+
+sub UnQuoteName ($)
+	{
+	my $value = shift;
+	$value =~ s/#([\da-f]{2})/chr(hex($1))/ige;
+	return $value;
+	}
+
+#################################################################
+=pod
+
+=head2 UnQuoteString ( string )
+
+This function extracts the text from PDF-strings and PDF-hexstrings.
+It will process all quoted characters and remove the enclosing braces.
+
+WARNING: The current version doesn't handle unicode strings properly.
+
+Returns a string.
+
+=cut
+
+sub UnQuoteString ($)
+	{
+#
+# Translate quoted character. 
+#
+	my $param = shift;
+	my $value;
+	if (($value) = $param =~ m/^<(.*)>$/)
+		{
+		$value =~ tr/0-9A-Fa-f//cd;
+		$value .= "0" if (length ($value) % 2);
+		$value =~ s/([\da-f]{2})/chr(hex($1))/ige;
+		}
+	elsif (($value) = $param =~ m/^\((.*)\)$/)
+		{
+		my %quoted = ("n" => "\n", "r" => "\r",
+					  "t" => "\t", "b" => "\b",
+					  "f" => "\f", "\\" => "\\",
+					  "(" => "(", ")" => ")");
+		$value =~ s/\\([nrtbf\\()]|[0-7]{1,3})/
+		defined ($quoted{$1}) ? $quoted{$1} : chr(oct($1))/gex;
+		}
+	else
+		{
+		$value = $param;
+		}
+
+	return $value;
+	}
+
+#################################################################
+=pod
+
+=head2 QuoteName ( string )
+
+This function quotes problematic characters in a PDF-name. This
+function should be used before writing a PDF-name back to a PDF-file.
+
+Returns a string.
+
+=cut
+
+sub QuoteName ($)
+	{
+	my $value = shift;
+	$value =~ s/(?<!\A)([\x00-\x20\x7f-\xff%()\[\]<>\/{}#])/
+						 sprintf ("#%2.2X", ord($1))/gex;
+	return $value;
+	}
+
+#################################################################
+=pod
+
+=head2 QuoteHexString ( string )
+
+This function translates a string into a PDF-hexstring. 
+
+Returns a string.
+
+=cut
+
+sub QuoteHexString ($)
+	{
+	my $value = shift;
+
+	$value =~ s/(.)/sprintf ("%2.2X", ord($1))/ge;
+	return ("<" . $value . ">");
+	}
+
+#################################################################
+=pod
+
+=head2 QuoteString ( string )
+
+This function translates a string into a PDF-string. Problematic
+character will be quoted.
+
+WARNING: The current version doesn't handle unicode strings properly.
+
+Returns a string.
+
+=cut
+
+sub QuoteString ($)
+	{
+	#
+	# Only \character style quotes will be added. The really important
+	# characters to quote are: ()\
+	# 
+	my $value = shift;
+
+	my %quote = ("\n" => "\\n", "\r" => "\\r",
+				  "\t" => "\\t", "\b" => "\\b",
+				  "\f" => "\\f", "\\" => "\\\\",
+				  "(" => "\\(", ")" => "\\)");
+	$value =~ s/([\n\r\t\b\f\\()])/$quote{$1}/g;
+	return ("(" . $value . ")");
+	}
+
+#################################################################
+=pod
+
+=head2 PDFGetPrimitive ( filehandle, offset )
+
+This internal function is used while parsing a PDF-file. If you are
+not writing extentions for this library and are parsing some special
+parts of the PDF-file, stay away and use B<GetObject> instead.
+
+This function has many quirks and limitations. Check the source for details.
+
+=cut
+
+sub PDFGetPrimitive (*\$)
+	{
+	my $fd = shift;
+	my $offset = shift;
+
+	binmode $fd;
+	seek $fd, $$offset, 0;
+
+	my $state = 0;
+	my $buffer;
+	my @collector;
+	my $lastchar;
+
+	while ()
+		{
+		# File offset is positioned on start of stream.
+		last if ($state == -4);
+
+		$state = 0;
+
+		# Process last element
+		if ($#collector >= 0)
+			{
+			my $lastvalue = $collector[$#collector];
+			
+			if ($lastvalue eq "R")
+				{
+				# Process references
+				if ($#collector >= 2
+					&& $collector[$#collector - 1] =~ m/\d+/
+					&& $collector[$#collector - 2] =~ m/\d+/)
+					{
+					$collector[$#collector - 2] .= join (" ", 
+						"", @collector[$#collector - 1, $#collector]);
+					$#collector -= 2; 
+					}
+				else
+					{
+					carp "Bad reference at offset ", $$offset;
+					}
+				}
+			elsif ($lastvalue eq "endobj")
+				{
+				# End of object
+				last;
+				}
+			elsif ($lastvalue eq "stream")
+				{
+				# End of object
+				$state = -4;
+				}
+			}
+		
+		# Set state for next element
+		if ($buffer eq "[") 
+			{
+			# Read array
+			$buffer = "";
+			push @collector, [ PDFGetPrimitive ($fd, $offset) ];
+			}
+		elsif ($buffer eq "<<")
+			{
+			# Read dictionary
+			$buffer = "";
+			push @collector, { PDFGetPrimitive ($fd, $offset) };
+			}
+		elsif ($buffer eq "(") 
+			{
+			# Here comes a string
+			$state = 1;
+			$lastchar = "";
+			}
+		elsif ($buffer eq "<") 
+			{
+			# Here comes a hex string
+			$state = -1;
+			}
+		elsif ($buffer eq ">")
+			{
+			# Wait for next > to terminate dictionary
+			$state = -2;
+			}
+		elsif ($buffer eq "%")
+			{
+			# Skip comments
+			$state = -3;
+			$buffer = "";
+			}
+		elsif ($buffer eq "]")
+			{
+			last;
+			}
+		elsif ($buffer eq ">>")
+			{
+			last;
+			}
+
+		# Read next item
+		while (read ($fd, $_, 1))
+			{
+			$$offset++;
+
+			if ($state == 0)
+				{
+				# Normal mode
+				if (m/[^\x00-\x20\x7f-\xff%()\[\]<>\/]/)
+					{
+					# Normal character inside a name or number
+					$buffer .= $_;
+					}
+				elsif (m/[\/\(\[\]\<\>%]/)
+					{
+					if ($buffer ne "")
+						{
+						# A new item starts
+						if ($buffer =~ m/^\//)
+							{
+							push @collector, UnQuoteName ($buffer);
+							}
+						else
+							{
+							push @collector, $buffer;
+							}
+						}
+					$buffer = $_;
+					last;
+					}
+				elsif (m/\s/)
+					{
+					# All kind of whitespaces are ignored
+					if ($buffer ne "")
+						{
+						# The old item is done starts
+						if ($buffer =~ m/^\//)
+							{
+							push @collector, UnQuoteName ($buffer);
+							}
+						else
+							{
+							push @collector, $buffer;
+							}
+						$buffer = "";
+						last;
+						}
+					}
+				else
+					{
+					# Strange character. Should not exist.
+					# Complain and move on.
+					carp "Strange character '", $_, "' at offset ",
+					$$offset, " in mode ", $state, " detected";
+					$buffer .= $_;
+					}
+				}
+			elsif ($state > 0)
+				{
+				# We have a string
+
+				if ($lastchar =~ m/\\[\r\n]+/ && m/[^\r\n]/)
+					{
+					# Clean up after line continuation
+					$lastchar = "";
+					}
+
+				if ($lastchar =~ m/\\[\r\n]*/)
+					{
+					# Process character after backslash
+					if (m/[\r\n]/)
+						{
+						# end of line
+						$lastchar .= $_;
+						}
+					else
+						{
+						# Just a quote
+						$buffer .= $lastchar . $_;
+						$lastchar = "";
+						}
+					}
+				else
+					{
+					if ($_ eq "\\")
+						{
+						# Quoted string starts
+						$lastchar = $_;
+						}
+					elsif ($_ eq "(")
+						{
+						# Count braces
+						$buffer .= $_;
+						$state ++;
+						}
+					elsif ($_ eq ")")
+						{
+						# End of string
+						$buffer .= $_;
+						unless (-- $state)
+							{
+							push @collector, $buffer;
+							$buffer = "";
+							last;
+							}
+						}
+					else
+						{
+						$buffer .= $_;
+						}
+					}
+				}
+			elsif ($state == -1)
+				{
+				if (m/[0-9a-f\s]/i)
+					{
+					# Hex character
+					$buffer .= $_;
+					}
+				elsif ($_ eq ">")
+					{
+					# End of string
+					$buffer .= $_;
+					push @collector, $buffer;
+					$buffer = "";
+					last;
+					}
+				elsif ($_ eq "<" && $buffer eq "<")
+					{
+					# This is not a string, but a dictionary instead
+					$buffer .= $_;
+					last;
+					}
+				else
+					{
+					# Should not be there. Complain and add it to the $buffer
+					carp "Bad character '", $_ , "' in hex string";
+					$buffer .= $_;
+					}
+				}
+			elsif ($state == -2)
+				{
+				# Wait for second > to terminate dictionary
+
+				# Some sanity checks
+				carp "Character '", $_, "' appeared while waiting for '>'" 
+				if ($_ ne ">");
+				carp "Buffer contains '", $buffer, "' and not '>'" 
+				if ($buffer ne ">");
+
+				$buffer = ">>";
+				last;
+				}
+			elsif ($state == -3)
+				{
+				# Skip comments;
+				last if (m/[\r\n]/);
+				}
+			elsif ($state == -4)
+				{
+				# Wait for newline to start stream
+
+				if ($_ eq "\n")
+					{
+					# Some sanity checks
+					carp "Text '", $buffer, 
+					"' appeared while waiting for start of stream" 
+					if ($buffer ne "");
+
+					$buffer = "";
+					last;
+					}
+				elsif (m/\S/)
+					{
+					$buffer .= $_;
+					}
+				}
+			else
+				{
+				# Unhandled status. Complain and reset
+				carp "Unhandled status ", $state;
+				}
+			}
+		if ($_ eq "")
+			{
+			# Unhandled status. Complain and reset
+			carp "Premature end of file reached";
+			
+			if ($buffer ne "")
+				{
+				push @collector, $buffer;
+				$buffer = "";
+				}
+			last;
+			}
+		}
+
+	return @collector;
+	}
+
+#################################################################
+=pod
+
+=head2 PDFGetline ( filehandle, offset )
+
+This internal function was used to read a line from a PDF-file. It has
+many limitations and you should stay away from it, if you don't know
+what you are doing. Use B<GetObject> or B<PDFGetPrimitive> instead.
+
+=cut
+
+sub PDFGetline {
+#
+# BUG WARNING:
+#
+# This function returns only one line, which doesn't mean anything most of the
+# time. Except for the fileheader and the xref-table, linebreaks can (and will!)
+# occur everywhere in a PDF and are just whitespace. You may find only part of a
+# PDF-primitve on one line, or more than one of them.
+#
+# If you want to read PDF-Primitves, use the function PDFGetPrimitive instead.
+#
+    my $fd = shift;
+    my $offset=shift;
+
+    my $buffer;
+    my $endflag=1;
+
+    binmode $fd;
+    seek $fd, $$offset, 0;
+
+    read($fd,$buffer,2);
+    $buffer =~ s/^\r?\n?// ;
+
+    $$offset +=2;
+
+    while ($endflag) {
+      read($fd,$_,1);
+      $$offset++;
+      $endflag = 0 if ( $_ eq "\r" || $_ eq "\n");
+      $buffer = $buffer . $_ ;
+    }
+    return $buffer;
+	}
+
+#################################################################
+#
+# Constructors
+#
+#################################################################
+
+=pod
+
+=head1 Constructor
+
+=cut
+
+#################################################################
+=pod
+
+=head2 new ( [ filename ] )
+
+This is the constructor of a new PDF object. If the filename is
+missing, it returns an empty PDF descriptor ( can be filled with
+$pdf->TargetFile). Otherwise, It acts as the B<PDF::Parse::TargetFile>
+method.
+
+=cut
+
+sub new {
+
+	my %PDF_Fields = (
+		  File_Name => undef, # Name of file
+		  File_Handler => undef, # Open handle to file
+		  Header => undef, # Identification string
+
+		  Objects => [], # Offset of objects
+		  Gen_Num => [], # Genereation number of objects
+		  Object_Length => [],	# Length of processed objects
+		  Object_Cache => {}, # Cache for objects.
+		  Page => [], # Information about all pages. Useful.
+
+		  Updated => 0,	# Is the PDF updated 
+		  Last_XRef_Offset => undef, # File offset of active Xref table
+		  Trailer => {}, # Content of active trailer
+		  Info => {}, # Content of active info object
+		  Catalog => {}, # Content of catalog
+		  PageTree => {}, # Content of root page
+		  );
+my $that = shift;
+my $class=ref($that) || $that ;
+  my $self = \%PDF_Fields ;
+  my $buf2=bless $self, $class;
+  if ( @_ ) { 			# I have the filename
+    $buf2->TargetFile($_[0]) ; 
+  }
+  return bless $self, $class;
+};
+
+#################################################################
+sub DESTROY {
+#
+# Close the file if not empty
+#
+  my $self = shift;
+  close ( $self->{File_Handler} ) if $self->{File_Handler} ;
+}
+
+#################################################################
+#
+# Methods
+#
+#################################################################
+
+=pod
+
+=head1 Methods
+
+The available methods are:
+
+=cut
+
+#################################################################
+=pod
+
+=head2 GetObject (reference)
+
+This methods returns the PDF-object for B<reference>. The string
+B<reference> must match the regular expression /^\d+ \d+ R$/,
+where the first number is the object number, the second number the
+generation number.
+
+The return value is a PDF-primitive, the type depends on the content
+of the object:
+
+=over
+
+=item B<undef>
+
+The object could not be found or an error. Not all referenced objects
+need to be present in a PDF-file. This value can be ignored.
+
+=item B<Hash Reference>
+
+If (UNIVERSAL::isa ($retval, "HASH") is true, the object is a
+PDF-dictionary. The keys of the hash should be either a PDF name (eg:
+/MediaBox) or a generated value like Stream_Offset. Everything else is
+an error.
+
+The values of the hash can be any PDF-primitive, including PDF-arrays
+and other dictionaries.
+
+This is the most common value returned by GetObject. If the key
+Stream_Offset exists, the dictionary is followed by stream data,
+starting at the file offeset indicated by this value.
+
+=item B<Array Reference>
+
+If (UNIVERSAL::isa ($retval, "ARRAY") is true, the object is a
+PDF-array. Each element may be of a different type, and may contain
+further references to arrays or any other PDF-primitive.
+
+=item B<String matching /^\d+ \d+ R$/>
+
+This is a reference to another PDF-Object. This value can be passed to
+GetObject. This kind of value may appear instead of most other types.
+Some PDF-writing programs seem to have special fun writing references
+when a simple number is expected. If the final number is need, use
+code like this to resolve references:
+
+while ($len =~ m/^\d+ \d+ R$/) {$len = $self->GetObject ($len);	}
+
+Example: 22 0 R
+
+=item B<String matching /^\//>
+
+This is a Name in a PDF dictionary. This string is already processed
+by B<UnQuotName> and may differ from the value in the PDF-file. In
+some very old andstrange non-standard PDF-files, this may lead to
+confusion.
+
+Example: /MediaBox
+
+=item B<String matching /^\(.*\)$/>
+
+This is a string. It may contain newlines, quoted characters und other
+strange stuff. Use PDF::UnQuoteString to extract the text.
+
+Example: (This is\na string with two \(2\) lines.)
+
+=item B<String matching /^E<lt>.*E<gt>$/>
+
+This is a hex encoded string. Use PDF::UnQuoteString to extract the text.
+
+Example: E<lt>48 45 4c4C4 F1cE<gt>
+
+=item B<String matching /^[\d.\+\-]+$/>
+
+This is probably a number.
+
+Example: 611
+
+=item B<String matching none of the above>
+
+this is either a PDF bareword (eg. true, false, ...) or a value
+generated by this method like Stream_Offset.
+
+Example: true
+
+=back
+
+To improve performance GetObject uses an internal cache for objects.
+Repeated requests for the same objects are not read form the file but
+satisfied from the cache. With the Variable B<$PDF::Core::UseObjectCache>,
+the caching mechanism can be turned off.
+
+B<WARNING>
+
+Special care must be taken, when returned objects are modified. If the
+object contains sub-objects, the sub-objects are not duplicated and
+all changes affect all other copies of this object. Use your own copy,
+if you need to modify those values.
+
+=cut
+
+sub GetObject (\*$;$)
+	{
+	my $self = shift;
+	my $ref = shift;
+	my $force = shift;
+
+#
+# Is PDF file open?
+#
+	croak "PDF-file not open." unless ($self->{"File_Handler"});
+
+#
+# Check reference
+#
+	my ($ind, $gen);
+	unless (($ind,$gen) = $ref =~ m/^(\d+) (\d+) R$/)
+		{
+		carp "Bad object reference '", $_, "'";
+		return undef;
+		}
+	if ($ind > $#{$self->{"Gen_Num"}} || $self->{"Gen_Num"}[$ind] != $gen)
+		{
+		#
+		# The page does not exist. According to the PDF specification,
+		# this is not an error.
+		#
+		return undef;
+		}
+
+	# Remove leading zero for cache key.
+	$ind += 0;
+	# Check cache
+	if ($UseObjectCache && ! $force
+		&& defined($self->{"Object_Cache"}{$ind}))
+		{
+		return $self->{"Object_Cache"}{$ind};
+		}
+
+	my $offset = $self->{"Objects"}[$ind];
+	my @data = PDFGetPrimitive ($self->{"File_Handler"}, $offset);
+
+	unless ($#data == 4  && $data[0] == $ind 
+		&& $data[1] == $gen && $data[2] eq "obj")
+		{
+		carp "Object mismatch: Got '", join (" ", @data[0..2]),
+		"' instead of '", join (" ", $ind, $gen, "obj"), "'";
+		return;
+		}
+
+	#
+	# An object is not always a dictionary. In such cases,
+	# adding additional keys breaks the content.
+	#
+	if (UNIVERSAL::isa ($data[3], "HASH"))
+		{
+		if ($data[4] eq "stream")
+			{
+			#
+			# Find end of a stream object
+			#
+			$data[3]{"Stream_Offset"} = $offset;
+			my $len = $data[3]{"/Length"};
+
+			# Length can be a reference to another object. 
+			# Resolve references in this case till something else appears.
+			while ($len =~ m/^\d+ \d+ R$/)
+				{
+				$len = $self->GetObject ($len);
+				}
+
+			# Skip stream
+			if ($len =~ m/^\d+$/)
+				{
+				$offset += $len;
+				}
+			else
+				{
+				carp "Strange: /Length resolves to '", $len, "' in object ", 
+				join (" ", @data[0..2]);
+				}
+
+			my @enddata = PDFGetPrimitive ($self->{"File_Handler"}, $offset);
+			$data[4] = $enddata[$#enddata];
+			}
+		}
+
+	#
+	# Save length of object.
+	#
+	$self->{"Object_Length"}[$ind] = $offset - $self->{"Objects"}[$ind];
+
+	carp "Bad object termination '", $data[4], "' in object ", 
+	join (" ", @data[0..2]) if ($data[4] ne "endobj");
+	
+
+	# Update cache
+	$self->{"Object_Cache"}{$ind} = $data[3] if ($UseObjectCache);
+
+	return $data[3];
+	}
+
+#
+# End of Modification by johi: 18.12.1999
+#
+#################################################################
+
+
+1;
+__END__
+
+=pod
+
+=head1 Variables
+
+Available variables are:
+
+=over 4
+
+=item B<$PDF::Core::VERSION>
+
+Contains the version of the library installed
+
+=item B<$PDF::Core::UseObjectCache>
+
+If this variable is true, all processed objects will be added to the
+object cache. If only header information of a PDF are read or very big
+PDF are processed, turning off the cache reduces the memory usage.
+
+=back 4
+
+=head1 Copyright
+
+  Copyright (c) 1998 - 2000 Antonio Rosella Italy antro@tiscalinet.it, Johannes Blach dw235@yahoo.com 
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 Availability
+
+The latest version of this library is likely to be available from:
+
+http://www.geocities.com/CapeCanaveral/Hangar/4794/
+
+=cut
Index: /trunk/gsdl/bin/script/indexes/PDF.pm
===================================================================
--- /trunk/gsdl/bin/script/indexes/PDF.pm	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/PDF.pm	(revision 1971)
@@ -0,0 +1,153 @@
+#
+# PDF.pm, version 1.11 February 2000 antro
+#
+# Copyright (c) 1998 - 2000 Antonio Rosella Italy antro@tiscalinet.it, Johannes Blach dw235@yahoo.com 
+#
+# Free usage under the same Perl Licence condition.
+#
+
+package PDF;
+
+$PDF::VERSION = "1.11";
+
+require 5.005;
+
+#require PDF::Core;  
+#require PDF::Parse; 
+require Core;  
+require Parse;
+ 
+use strict;
+use Carp;
+use Exporter ();
+
+use vars qw(@ISA $Verbose);
+
+#
+# Verbose off by default
+#
+$Verbose = 0;
+
+@ISA = qw(Exporter PDF::Core PDF::Parse);
+
+1;
+
+__END__
+
+=head1 NAME
+
+PDF - Library for PDF access and manipulation in Perl
+
+=head1 SYNOPSIS
+
+  use PDF;
+
+  $pdf=PDF->new ;
+  $pdf=PDF->new(filename);
+
+  $result=$pdf->TargetFile( filename );
+
+  print "is a pdf file\n" if ( $pdf->IsaPDF ) ;
+  print "Has ",$pdf->Pages," Pages \n";
+  print "Use a PDF Version  ",$pdf->Version ," \n";
+  print "and it is crypted  " if ( $pdf->IscryptedPDF) ;
+
+  print "filename with title",$pdf->GetInfo("Title"),"\n";
+  print "and with subject ",$pdf->GetInfo("Subject"),"\n";
+  print "was written by ",$pdf->GetInfo("Author"),"\n";
+  print "in date ",$pdf->GetInfo("CreationDate"),"\n";
+  print "using ",$pdf->GetInfo("Creator"),"\n";
+  print "and converted with ",$pdf->GetInfo("Producer"),"\n";
+  print "The last modification occurred ",$pdf->GetInfo("ModDate"),"\n";
+  print "The associated keywords are ",$pdf->GetInfo("Keywords"),"\n";
+
+  my (startx,starty, endx,endy) = $pdf->PageSize ($page) ;
+
+=head1 DESCRIPTION
+
+The main purpose of the PDF library is to provide classes and
+functions that allow to read and manipulate PDF files with perl. PDF
+stands for Portable Document Format and is a format proposed by Adobe.
+A full description of this format can be found in the B<Portable
+Document Reference Manual> by B<Adobe Systems Inc.>. For more details
+about PDF, refer to:
+
+B<http://www.adobe.com/>
+
+The main idea is to provide some "basic" modules for access 
+the information contained in a PDF file. Even if at this
+moment is in an early development stage, the scripts in the 
+example directory show that it is usable. 
+
+B<is_pdf> script test a list of files in order divide the PDF file
+from the non PDF using the info provided by the files 
+themselves. It doesn't use the I<.pdf> extension, it uses the information
+contained in the file.
+
+B<pdf_version> returns the PDF level used for writing a file.
+
+B<pdf_pages> gives the number of pages of a PDF file. 
+
+B<pagedump.pl> prints some information about individual pages in a
+PDF-file. Although the information as such are not very useful, it
+demontrates well some more complex aspects of the library. Check the
+function B<doprint> in this program on how to handle all possible data
+occuring in a PDF.
+
+The library is now splitted in 2 section :
+
+B<PDF::Core> that contains the data structure, the constructor and low
+level access fuctions;
+
+B<PDF::Parse> all kind of functions to parse the PDF-files and
+provide information about the content.
+
+Check the help-files of these modules for more details.
+
+=head1 Variables
+
+There are 2 variables that can be accessed:
+
+=over 4
+
+`=item B<$PDF::VERSION>
+
+Contain the version of the library installed.
+
+=item B<$PDF::Verbose>
+
+This variable is false by default. Change the value if you want 
+more verbose output messages from library.
+
+=back 4
+
+=head1 Copyright
+
+  Copyright (c) 1998 - 2000 Antonio Rosella Italy antro@tiscalinet.it, Johannes Blach dw235@yahoo.com 
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 Availability
+
+The latest version of this library is likely to be available from:
+
+http://www.geocities.com/CapeCanaveral/Hangar/4794/
+
+and at any CPAN mirror
+
+=head1 Greetings
+
+Fabrizio Pivari ( pivari@geocities.com ) for all the suggestions about life, the universe and everything.
+Brad Appleton ( bradapp@enteract.com ) for his suggestions about the module organization.
+Thomas Drillich for the iso latin1 support 
+Ross Moore ( ross@ics.mq.edu.au ) for ReadInfo fix
+
+=cut
+
+
+
+
+
+
+
Index: /trunk/gsdl/bin/script/indexes/Parse.pm
===================================================================
--- /trunk/gsdl/bin/script/indexes/Parse.pm	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/Parse.pm	(revision 1971)
@@ -0,0 +1,513 @@
+#
+# PDF::Parse.pm, version 1.11 February 2000 antro
+#
+# Copyright (c) 1998 - 2000 Antonio Rosella Italy antro@tiscalinet.it, Johannes Blach dw235@yahoo.com 
+#
+# Free usage under the same Perl Licence condition.
+#
+
+package PDF::Parse;
+
+$PDF::Parse::VERSION = "1.11";
+
+=pod
+
+=head1 NAME
+
+PDF::Parse - Library with parsing functions for PDF library
+
+=head1 SYNOPSIS
+
+  use PDF::Parse;
+
+  $pdf->TargetFile($filename);
+  $pdf->LoadPageInfo;
+
+  $version = $pdf->Version;
+  $bool = $pdf->IsaPDF;
+  $bool = $pdf->IscryptPDF;
+
+  $info = $pdf->GetInfo ($key);
+  $pagenum = $pdf->Pages;
+
+  @size = $pdf->PageSize ($page);
+  # or
+  @size = $pdf->PageSize;
+
+  $rotation = $pdf->PageRotation ($page);
+  # or
+  $rotation = $pdf->PageRotation;
+
+=head1 DESCRIPTION
+
+The main purpose of the PDF::Parse library is to provide parsing functions
+for the more general PDF library.
+
+=head1 Methods
+
+The available methods are:
+
+=cut
+
+require 5.005;
+#require PDF::Core;
+require Core;
+
+use strict;
+use Carp;
+use Exporter ();
+
+use vars qw(@ISA @EXPORT_OK);
+
+@ISA = qw(Exporter PDF::Core);
+
+@EXPORT_OK = qw( LoadPageInfo GetInfo TargetFile
+				 Pages PageSize PageRotation IsaPDF
+				 Version IscryptPDF );
+
+#################################################################
+sub ReadCrossReference_pass1 {
+  my $fd = shift;
+  my $offset=shift;
+  my $self=shift;
+
+  my $initial_number;
+  my $obj_counter=0;
+  my $global_obj_counter=0;
+  my $buf;
+
+  binmode $fd;
+
+  $_=PDF::Core::PDFGetline ($fd,\$offset);
+
+  die "Can't read cross-reference section, according to trailer\n" if ! /xref\r?\n?/  ;
+
+  while () {
+    $_=PDF::Core::PDFGetline ($fd,\$offset);
+    s/^\n//;
+    s/^\r//;
+    last if (m/\btrailer\b/) ;
+#
+# An Object
+#
+    /^\d+\s+\d+\s+n\r?\n?/ && do { my $buf =$_;
+	       my $ind = $initial_number + ($obj_counter++);
+               ( not defined $self->{Objects}[$ind] )&& 
+		  do { $self->{Objects}[$ind] = int substr($buf,0,10);
+		       $self->{Gen_Num}[$ind] = int substr($buf,11,5);
+		     };
+	       $_=$buf;
+	       s/^.{18}//; 
+	       next ;
+   }; 
+#
+# A Freed Object
+#
+    /^\d+\s+\d+\s+f\r?\n?/ && do { my $buf =$_;
+   	       my $objects_generation_nr = substr($buf,11,5);
+	       my $Num=substr($buf,0,10);
+	       my $ind = $initial_number + ($obj_counter++);
+	       # $ind = $ind . "_" . $objects_generation_nr;
+		       $self->{Objects}[$ind] = - $Num;
+		       $self->{Gen_Num}[$ind] = $objects_generation_nr;
+		       $_=$buf;
+		       s/^.{18}//; 
+		       next ;
+     };
+#
+# A subsection
+#
+    /^\d+\s+\d+\r?\n?/  && do { 
+ 	my $buf = $_ ; 
+ 	 $initial_number = $buf; 
+ 	 $initial_number=~ s/^(\d+)\s+\d+\r?\n?.*/$1/; 
+	 $global_obj_counter += $obj_counter;
+ 	 $obj_counter=0; 
+	 next ;
+    };
+  }
+
+  $global_obj_counter +=$obj_counter;
+#
+# Now the trailer for updates 
+#
+
+#
+# Skip to start of dictionary.
+#
+    until (m/<</)
+		{
+		$_=PDF::Core::PDFGetline ($fd,\$offset);
+		}
+
+#
+# Read the dictionary
+#
+    my %trailer = ( PDF::Core::PDFGetPrimitive ($fd, $offset) );
+
+    if ($self->{"Trailer"}{"/Root"} eq "")
+		{
+		$self->{"Trailer"} = \%trailer;
+		#
+		# This code is here for backward compatibility only. If the content
+		# of the root trailer is needed, use $self->{"Trailer"} instead.
+		#
+		$self->{"Cross_Reference_Size"} = $trailer{"/Size"};
+		$self->{"Root_Object"} = $trailer{"/Root"};
+		$self->{"Crypt_Object"} = $trailer{"/Encrypt"};
+		}
+	if ($trailer{"/Prev"} =~ m/^\d+$/)
+		{  
+  		$self->{"Updated"} = 1;
+		my $old_seek = tell $fd;
+		$global_obj_counter += ReadCrossReference_pass1 ($fd,
+            $trailer{"/Prev"}, $self );
+		seek $fd, $old_seek, 0;
+		}
+
+
+  return $global_obj_counter;
+}
+
+#################################################################
+sub LoadPageSubtree (\*$;%)
+	{
+	my $self = shift;
+	my $ref = shift;
+	my %inheritance = @_ ;
+
+	my $data = $self->GetObject ($ref);
+
+	# Check which attributes are inherited. Adobe did not add any new
+	# inherited attributes in version 1.2 or later, so this list is
+	# complete.
+
+	# Do simple values.
+	foreach my $key ("/Rotate", "/Dur", "/Hid", "/Trans", 
+			 "/MediaBox", "/CropBox") {
+
+	    if (defined ($data->{$key})){
+
+		# Check if it is an indirect reference
+		if ($data->{$key} =~ m/^\d+ \d+ R$/) {
+		    
+		    my $dataref = $data->{$key};
+
+		    do {
+
+			$dataref = $self->GetObject ($dataref);
+
+		    } while ($dataref =~ m/^\d+ \d+ R$/);
+
+		    if (UNIVERSAL::isa ($data, "ARRAY")){
+
+			$inheritance{$key} = [];
+
+			foreach my $i (@{$data}){
+			    # Each element may be a reference.
+			    while ($i =~ m/^\d+ \d+ R$/){
+				$i = $self->GetObject ($i);
+			    }
+			    
+			    push @{$inheritance{$key}}, $i;
+			}
+		    } else {
+			$inheritance{$key} = $dataref;
+		    }
+		} else { #not an indirect reference
+		    $inheritance{$key} = $data->{$key};
+		}
+	    }
+	}
+	
+	# If this objects contains ressources, replace information in inheritance
+	$inheritance{"Resource_Object"} = $data->{"/Resources"}
+	    if (defined ($data->{"/Resources"}));
+
+	if ($data->{"/Type"} eq "/Pages")
+		{
+		# It's just an intermediate Node
+		foreach my $kid (@{$data->{"/Kids"}})
+			{
+			$self->LoadPageSubtree ($kid, %inheritance);
+			}
+		}
+	elsif ($data->{"/Type"} eq "/Page")
+		{
+		# We have a real page!
+		$inheritance{"Page_Object"} = $ref;
+		push @{$self->{"Page"}}, +{ %inheritance };
+		}
+	else
+		{
+		# Strange stuff. Complain and discard.
+		carp "While loading pages got object of type '", $data->{"/Type"}, "'";
+		}
+	}
+
+#################################################################
+=pod
+
+=head2 TargetFile ( filename )
+
+This method links the filename to the pdf descriptor and parses all
+kind of header information.
+
+=cut
+
+sub TargetFile {
+  my $self = shift;
+  my $file = shift;
+
+  croak "Already linked to the file ",$self->{File_Name},"\n" 
+      if $self->{File_Name} ;
+  
+  my $offset;
+
+  if ( $file ) {
+    open(FILE, "< $file") or croak "can't open $file: $!";
+    binmode FILE;
+    $self->{File_Name} = $file ;
+    $self->{File_Handler} = \*FILE;
+    my $buf;
+    read(FILE,$buf,4);
+    if ( $buf ne "%PDF" ) {
+     print "File $_[0] is not PDF compliant !\n" if $PDF::Verbose ;
+     return 0 ;
+    }
+    read(FILE,$buf,4);
+    $buf =~ s/-//;
+    $self->{Header}= $buf;
+    seek FILE,-50,2;
+    read( FILE, $offset, 50 );
+    $offset =~ s/[^s]*startxref\r?\n?(\d*)\r?\n?%%EOF\r?\n?/$1/;
+
+	$self->{"Last_XRef_Offset"} = $offset;
+    ReadCrossReference_pass1 (\*FILE, $offset, $self);
+	$self->{"Info"} = $self->GetObject ($self->{"Trailer"}{"/Info"});
+	$self->{"Catalog"} = $self->GetObject ($self->{"Trailer"}{"/Root"});
+	$self->{"PageTree"} = $self->GetObject ($self->{"Catalog"}{"/Pages"});
+    return 1;
+  } else {
+    croak "I need a file name (!)";
+	}
+}
+
+#################################################################
+=pod
+
+=head2 LoadPageInfo
+
+This function loads the information for all pages. This process can
+take some time for big PDF-files.
+
+=cut
+
+sub LoadPageInfo (\*)
+	{
+	my $self = shift;
+
+	# Reset Page Array
+	$#{$self->{"Page"}} = -1;
+
+	# Recurse
+	$self->LoadPageSubtree ($self->{"Catalog"}{"/Pages"});
+	}								
+
+
+
+#################################################################
+=pod
+
+=head2 Version
+
+Returns the PDF version used for writing the object file.
+
+=cut
+
+sub Version { 
+  return ($_[0]->{Header}); 
+}
+
+#################################################################
+=pod
+
+=head2 IsaPDF
+
+Returns true, if the file could be parsed and is a PDF-file.
+
+=cut
+
+sub IsaPDF { 
+  return ($_[0]->{Header} != undef) ; 
+}
+
+#################################################################
+=pod
+
+=head2 IscryptPDF
+
+Returns true if the PDF contains a crypt object. This indicates that
+the data of the PDF-File is encrypted. In this case, not all function
+work as expected.
+
+=cut
+
+sub IscryptPDF { 
+  return ($_[0]->{Crypt_Object} != undef) ; 
+}
+
+#################################################################
+=pod
+
+=head2 GetInfo ( key )
+
+Returns the various information contained in the info section of a PDF
+file (if present). A PDF file can have:
+
+  a title ==> GetInfo ("Title")
+  a subject ==> GetInfo ("Subject")
+  an author ==> GetInfo("Author")
+  a creation date ==> GetInfo("CreationDate")
+  a creator ==> GetInfo("Creator")
+  a producer ==> GetInfo("Producer")
+  a modification date ==> GetInfo("ModDate")
+  some keywords ==> GetInfo("Keywords")
+
+=cut
+
+sub GetInfo (\*$)
+	{
+	my $self = shift;
+	my $type = shift;
+
+	return PDF::Core::UnQuoteString ($self->{"Info"}{"/" . $type})
+	}
+
+#################################################################
+=pod
+
+=head2 Pages
+
+Returns the number of pages of the PDF-file.
+
+=cut
+
+sub Pages 
+	{
+	my $self = shift;
+
+	return $self->{"PageTree"}{"/Count"};
+	}
+
+
+
+#################################################################
+=pod
+
+=head2 PageSize ( [ page ] )
+
+Returns the size of a page in the PDF-file. If no parameter is given,
+the default size of the root page will be returned. This value may be
+overridden for any page.
+
+If the size of an individual page is requested and the page data is
+not already loaded, the method B<LoadPageInfo> will be executed. This
+may take some time for large PDF-files. The size of the root page is
+always available and will never execute B<LoadPageInfo>.
+
+=cut
+
+sub PageSize (;$)
+	{
+	my $self = shift;
+	my $page = shift;
+
+	if ($page > 0)
+		{
+		return undef if ($page > $self->{"PageTree"}{"/Count"});
+		$self->LoadPageInfo unless ($#{$self->{"Page"}} >= 0);
+		
+		return @{$self->{"Page"}[$page - 1]{"/MediaBox"}}
+		if (defined $self->{"Page"}[$page - 1]{"/MediaBox"});
+		}
+	else
+		{
+		return @{$self->{"PageTree"}{"/MediaBox"}}
+		if (defined $self->{"PageTree"}{"/MediaBox"});
+		}
+
+	return undef;
+	}
+
+
+#################################################################
+=pod
+
+=head2 PageRotation ( [ page ] )
+
+Returns the rotation of a page in the PDF-file. If no parameter is given,
+the default rotation of the root page will be returned. This value may be
+overridden for any page.
+
+If the rotation of an individual page is requested and the page data is
+not already loaded, the method B<LoadPageInfo> will be executed. This
+may take some time for large PDF-files. The rotation of the root page is
+always available and will never execute B<LoadPageInfo>.
+
+=cut
+sub PageRotation (;$)
+	{
+	my $self = shift;
+	my $page = shift;
+
+	my $rotate = 0;
+
+	if ($page > 0)
+		{
+		return undef if ($page > $self->{"PageTree"}{"/Count"});
+		$self->LoadPageInfo unless ($#{$self->{"Page"}} >= 0);
+		
+		$rotate = $self->{"Page"}[$page - 1]{"/Rotate"};
+		}
+	else
+		{
+		$rotate = $self->{"PageTree"}{"/Rotate"};
+		}
+
+	print "Rotation ", 0 + $rotate if ($PDF::Verbose);
+
+	return 0 + $rotate;
+	}
+#################################################################
+1;
+__END__
+
+=head1 Variables
+
+The only available variable is :
+
+=over
+
+=item B<$PDF::Parse::VERSION>
+
+Contains the version of the library installed
+
+=back
+
+
+=head1 Copyright
+
+  Copyright (c) 1998 - 2000 Antonio Rosella Italy antro@tiscalinet.it, Johannes Blach dw235@yahoo.com 
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 Availability
+
+The latest version of this library is likely to be available from:
+
+http://www.geocities.com/CapeCanaveral/Hangar/4794/
+
+=cut
+
Index: /trunk/gsdl/bin/script/indexes/amend_pdf.pl
===================================================================
--- /trunk/gsdl/bin/script/indexes/amend_pdf.pl	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/amend_pdf.pl	(revision 1971)
@@ -0,0 +1,682 @@
+#!/usr/local/bin/perl
+#Jessica Thurston
+#usage: perl amend_pdf.pl filename
+#This program takes a pdf file 'filename'
+#and modifys it to include outline entries
+#(bookmarks).  
+#This is achieved using a pdf library which
+#parses the pdf file into objects allowing 
+#this script to more easily manipulate the pdf
+#objects and then modify the file by means
+#of incremental updates. (modifys the necessary
+#pdf objects and appends them to the end of 
+#the file, then updates the xreference table and
+#trailer). This library can be downloaded at
+# http://www.sanface.com/PDF-lib/
+#A file url.txt stored in the same
+#directory is read containing two columns of data:
+#title of related pdf document     url of related pdf document
+#The pdf document is modified so that the title of the
+#related pdf documents are displayed as bookmarks and
+#when the user clicks on it the web browser opens at
+#the url stored in the same column of url.txt.
+#
+#This program was designed to be used with the Greenstone
+#digital library in the following ways:
+#-When a user has built a collection containing
+# pdf documents, they have a choice of either displaying
+# the page in the web browser in gml form or saving the
+# original pdf document to view in an acrobat pdf reader.
+#-The related document file url.txt can be downloaded
+# in the same way if the user has included in the format
+# string for that page (ie search list) in the collection 
+# configuration file [urllink] related documents [/urllink].  
+# This will create a html link 'related documents' which 
+# when clicked on will enable the user to save a file url.txt 
+# containing the related documents for that particular document. 
+#-This file has been written upon running the perl script
+# relationPDF.pl which will also amend the gml documents to 
+# include the 'urllink' information enabling the user to 
+# include the related document links in config file format 
+# strings.
+#-So once this related doc info has been included the user
+# can download both the pdf file (doc.pdf) and the related
+# document file for that particluar document (url.txt).
+#-perl amend_pdf.pl doc.pdf is then run in the command line
+# modifying the pdf document to the desired effect.  
+#bugs:
+#-cannot be run more than once on the same file
+#-doesn't make use of free objects (free objects
+# are quite unlikely though, I didn't come across
+# any while looking through pdfs)
+#-many other things I haven't bothered testing
+
+use Carp;
+use Getopt::Long;
+use PDF;
+
+$objects = 0;
+$offsets = 1;
+
+
+#for each command line argument add the outlines
+#contained in url.txt
+#foreach (@ARGV) {
+#    create_outlines($_); 
+#}
+
+if(defined $ARGV[0]){
+    $pdf_document = $ARGV[0];
+} else {
+    print STDERR "You must supply pdf document filename\n";
+    return;
+}
+if(defined $ARGV[1]){
+    $related_docs = $ARGV[1];
+} else {
+print STDERR "You must supply related document filename\n";
+return;
+}
+create_outlines($pdf_document); 
+
+exit(1);
+
+
+#this function first checks to see is the file is indeed
+#a pdf file - if not then exits. If it is a pdf then it
+#checks to see if it is encrypted. If it is then exits.
+#Next we check if the outlines dictionary exists in the
+#document catalog. 
+#-If the outline entry exists but there are no actual outlines
+# present then call add_outlines but pass on the existing
+# outline dictionary.
+#-otherwise call modify_outlines to modify the existing outline
+# structure to include new outlines.
+#If outlines dictionary doesn't exist call add_outlines.
+sub create_outlines {
+
+  my $filename = shift;
+
+  #parse pdf filename
+  my @filelist = split("/", $filename);
+  my $file = pop @filelist;
+
+  print STDERR "pdf file to be manipulated: $file\n";
+  print STDERR "pdf file to be saved: tmp_$file\n";
+
+  #make a copy of that file in this directory
+  print STDERR "cp $filename $file\n"; 
+  `cp $filename $file\n`; 
+  `cp $filename tmp_$file\n`; 
+
+  #create and parse a new 'pdf' object
+  my $PDFfile = PDF->new($file);  
+
+  #if it is a pdf file
+  if ($PDFfile->{"Header"}){
+
+      if($PDFfile->IscryptPDF){
+	  #an encrypted file so cannot continue with
+	  #adding the related doc outlines to it 
+	  print STDERR "file \"$file\" is encrypted \n"; 
+	  return;
+      }
+
+      #display some relevant information about the document
+      print STDERR "Author: ", $PDFfile->GetInfo ("Author"), "\n"; 
+      print STDERR "Title: ", $PDFfile->GetInfo ("Title"), "\n"; 
+      print STDERR "Subject: ", $PDFfile->GetInfo ("Subject"), "\n"; 
+      print STDERR "Updated: ", $PDFfile->{"Updated"}, "\n";
+     
+      #if the pdf document already includes an outline dictionary
+      if (defined $PDFfile->{"Catalog"}{"/Outlines"}) {
+
+	  #get the outline object from the indirect ref
+	  my $outline_data = $PDFfile->GetObject($PDFfile->{"Catalog"}{"/Outlines"});
+	  #obtain the number of existing outlines
+	  $PDFfile->{"Outlines"}{"/Count"} = $outline_data->{"/Count"};
+	  print STDERR "number of existing outlines: $PDFfile->{\"Outlines\"}{\"/Count\"}\n";
+
+	  #this means that the pdf file had an outline dictionary but
+	  #did not actually include any outlines.
+	  if($PDFfile->{"Outlines"}{"/Count"} == 0){
+	      #obtain object number of outline dictionary and pass to add_outlines
+	      my $dictionary = split(/\s/, $PDFfile->{"Catalog"}{"/Outlines"});
+	     
+	      add_outlines($PDFfile, $file, $dictionary);
+	  } else { 
+	      #collect other outline data to pass to modify_outlines
+	      $PDFfile->{"Outlines"}{"/First"} = $outline_data->{"/First"};
+	      $PDFfile->{"Outlines"}{"/Last"} = $outline_data->{"/Last"};
+
+	      #modify last outline entry
+	      modify_outlines($outline_data, $PDFfile, $file);
+	  }
+      } else { #there was no outline dictionary thus no outlines so add some
+	  print STDERR "no bookmarks in \"$file\" \n"; 
+	  add_outlines($PDFfile, $file, 0);
+      }
+  } else { #the file was not a pdf file
+      print STDERR "$file is not a pdf file!!\n"; 
+  }
+
+
+  #copy back the file we modified and the saved copy 
+  my $copypath = join("/", @filelist);
+  print STDERR "cp $file $filename\n"; 
+  print STDERR "cp tmp_$file $copypath/tmp_$file\n"; 
+  `cp $file $filename\n`; 
+  `cp tmp_$file $copypath/tmp_$file\n`; 
+
+  #remove the copy of that file in this directory
+  #print STDERR "rm $file\n"; 
+  `rm $file\n`;  
+  `rm tmp_$file\n`; 
+}
+
+
+#add_outlines function recieves following params
+#PDF file information, filename of pdf file, outline dictionary
+#(if outline dict. is 0 that means it must be created).
+#First the function decides if we are to create new dictionary
+#or not. Next read in the url file. Open up the pdf document.
+#Modify the catalog so that it includes the outline dictionary
+#(this is done even if the catalog doesn't need modifying 
+# so that the objects in the objects/offset table will not
+# be all mucked up when it comes time to write the xreference
+# table)
+#Then append outline dictionary to end of file (either modified
+#or created). Then append the top heirarchy related document
+#outline.  Then the new file url bookmarks. Call  xref_table
+#to write new xreference table. Call trailer to write new trailer.
+
+#table[0][0] - document catalog
+#table[0][1] - document catalog offset
+#table[1][0] - outline dictionary
+#table[1][1] - outline dictionary offset
+#table[2][0] - related document outline
+#table[2][1] - related document outline offset
+#table[3][0] etc - url outlines, read from file
+#table[3][1] etc - url outlines offset, read from file
+
+sub add_outlines (*\$){
+    
+ my $PDFfile = shift; 
+ my $file = shift; 
+
+ my @table;
+ $table[1][$objects] = shift;
+
+ #read in file of url's
+ my @urls = read_file(); 
+ my $url_num = $#urls + 1;
+ 
+ #if outline dictionary was not present in catalog
+ if ($table[1][$objects] == 0){ #get new object number for new dictionary
+     $table[1][$objects] = $PDFfile->{"Trailer"}{"/Size"}; #outline dictionary to be created
+     $table[2][$objects] = $table[1][$objects] + 1; #related document outline
+ } else { #else get object number for related doc outline to be appended
+     $table[2][$objects] = $PDFfile->{"Trailer"}{"/Size"}; #related document outline
+ }
+ 
+ #open up pdf file for appending
+ open(FILE, ">> $file") or croak "can't open $file: $!"; 
+ binmode \*FILE;
+ 
+ #obtain object number and offset for the document catalog
+ $table[0][$objects] = split(/\s/, $PDFfile->{"Trailer"}{"/Root"});
+ $table[0][$offsets] = tell \*FILE;
+
+ #print the modified or original catalog back to the file (appended)
+ print FILE "$table[0][$objects] 0 obj
+";
+ print FILE "<<
+";
+ print FILE "/Pages $PDFfile->{\"Catalog\"}{\"/Pages\"}
+";
+ print FILE "/Outlines $table[1][$objects] 0 R
+"; #only line actually added
+ print FILE "/Type /Catalog
+";
+ print FILE "/DefaultGray $PDFfile->{\"Catalog\"}{\"/DefaultGray\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/DefaultGray"}));
+ print FILE "/DefaultRGB $PDFfile->{\"Catalog\"}{\"/DefaultRGB\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/DefaultRGB"}));
+ print FILE "/PageLabels $PDFfile->{\"Catalog\"}{\"/PageLabels\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/PageLabels"}));
+ print FILE "/Names $PDFfile->{\"Catalog\"}{\"/Names\"}
+" 
+     if (defined ($PDFfile->{"Catalog"}{"/Names"}));
+ print FILE "/Dests $PDFfile->{\"Catalog\"}{\"/Dests\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/Dests"}));
+ print FILE "/ViewerPreferences $PDFfile->{\"Catalog\"}{\"/ViewerPreferences\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/ViewerPreferences"}));
+ print FILE "/PageLayout $PDFfile->{\"Catalog\"}{\"/PageLayout\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/PageLayout"}));
+ print FILE "/PageMode $PDFfile->{\"Catalog\"}{\"/PageMode\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/PageMode"}));
+ print FILE "/Threads $PDFfile->{\"Catalog\"}{\"/Threads\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/Threads"}));
+ print FILE "/OpenAction $PDFfile->{\"Catalog\"}{\"/OpenAction\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/OpenAction"}));
+ print FILE "/URI $PDFfile->{\"Catalog\"}{\"/URI\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/URI"}));
+ print FILE "/Acroform $PDFfile->{\"Catalog\"}{\"/Acroform\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/Acroform"}));
+ print FILE "/StructTreeRoot $PDFfile->{\"Catalog\"}{\"/StructTreeRoot\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/StructTreeRoot"}));
+ print FILE "/SpiderInfo $PDFfile->{\"Catalog\"}{\"/SpiderInfo\"}
+"
+     if (defined ($PDFfile->{"Catalog"}{"/SpiderInfo"}));
+ print FILE ">>
+";
+ print FILE "endobj
+";
+ 
+ #obtain offset for outline dictionary
+ $table[1][$offsets] = tell \*FILE;
+
+ #append newly created outline dictionary
+ print FILE "$table[1][$objects] 0 obj
+";
+ print FILE "<<
+";
+ print FILE "/Type /Outlines
+";
+ print FILE "/Count ", $url_num + 1, "
+";
+ print FILE "/First $table[2][$objects] 0 R
+";
+ print FILE "/Last $table[2][$objects] 0 R
+";
+ print FILE ">>
+";
+ print FILE "endobj
+";
+
+
+ #get the related document outline object num and offset
+ my $obj = $table[2][$objects]; 
+ $table[2][$offsets] = tell \*FILE;
+
+ #append the top heirarchy related document outline to file 
+ print FILE "$table[2][$objects] 0 obj
+";
+ print FILE "<<
+";
+ print FILE "/Title (Related Documents)
+";
+ print FILE "/Parent $table[1][$objects] 0 R
+";
+ print FILE "/Count ", $url_num, "
+";
+ print FILE "/First ", $obj + 1, " 0 R
+";
+ print FILE "/Last ", $table[2][$objects] + $url_num, " 0 R
+";
+ print FILE ">>
+";
+ print FILE "endobj
+";
+
+ my $ind = 3;
+ $obj++;
+
+ 
+ #store the object nums and offsets of the new related document
+ #outlines and write them to the file (must be outline with
+ #an action eg go to specific url)
+ for $i ( 0 .. $#urls ) {
+     $table[$ind][$offsets] = tell \*FILE; 
+     $table[$ind][$objects] = $obj; 
+     print FILE "$obj 0 obj
+";
+     print FILE "<<
+";
+     print FILE "/Title ($urls[$i][0])
+"; 
+     print FILE "/Parent $table[2][$objects] 0 R
+";
+     print FILE "/Next ", $obj + 1, " 0 R
+" if (($obj + 1) <= ($table[2][$objects] + $url_num)); 
+     print FILE "/Prev ", $obj - 1, " 0 R
+" if(($obj - 1) != ($table[2][$objects]));
+     print FILE "/A << /Type /Action
+";
+     print FILE "/S /URI
+"; 
+     print FILE "/URI ($urls[$i][1])
+"; 
+     print FILE ">>
+";
+     print FILE ">>
+";
+     print FILE "endobj
+";
+     $obj++;
+     $ind++; 
+ }
+
+
+ #append new X-reference table 
+ my $xref_offset = tell \*FILE;
+ xref_table(\*FILE, $url_num, @table);
+
+ #print trailer 
+ trailer(\*FILE, $PDFfile, $obj); 
+ print FILE "$xref_offset
+";
+ print FILE "%%EOF
+"; 
+
+ #close FILE;
+}
+
+#modify_outlines function recieves following params
+#PDF file information, outline data, pdf filename
+#First the function obtains the object data for the
+#last outline entry. Next read in the url file. 
+#Open up the pdf document.Then append the modified 
+#outline dictionary to end of file. Next append the
+#modified last outline.  Then append the 
+#top heirarchy related document outline.  Then the 
+#new file url bookmarks. Call  xref_table
+#to write new xreference table. 
+#Call trailer to write new trailer.
+
+#table[0][0] - outline dictionary
+#table[0][1] - outline dictionary offset
+#table[1][0] - last outline
+#table[1][1] - last outline offset
+#table[2][0] - related document outline
+#table[2][1] - related document outline offset
+#table[3][0] etc - url outlines, read from file
+#table[3][1] etc - url outlines offset, read from file
+
+sub modify_outlines (*\$){
+
+    my ($outline_data, $PDFfile, $file) = @_;
+
+    #collect the data for the last outline (which must be modified)
+    $PDFfile->{"Outlines"}{"/Last"} = $outline_data->{"/Last"};
+    my $last_data = $PDFfile->GetObject($PDFfile->{"Outlines"}{"/Last"});  
+
+    #read in file of url's
+    my @urls = read_file(); 
+    my $url_num = $#urls + 1;
+ 
+    my @table;
+
+    #This number is the number to use for the next created object
+    #eg the related doc heirarchy
+    $table[2][$objects] = $PDFfile->{"Trailer"}{"/Size"};
+  
+    #open up the pdf file for appending
+    open(FILE, ">> $file") or croak "can't open $file: $!"; 
+    binmode \*FILE;
+    
+    #store the object number and offset of the outline dictionary
+    $table[0][$objects] = split(/\s/, $PDFfile->{"Catalog"}{"/Outlines"});
+    $table[0][$offsets] = tell \*FILE;
+   
+    #write the outline dictionary back to the file (appending)
+    print FILE "$table[0][$objects] 0 obj
+";
+    print FILE "<<
+";
+    print FILE "/Type /Outlines
+";
+    print FILE "/Count ", $PDFfile->{"Outlines"}{"/Count"} + 1, "
+"
+	if (defined ($PDFfile->{"Outlines"}{"/Count"}));
+    print FILE "/First $PDFfile->{\"Outlines\"}{\"/First\"}
+"
+	if (defined ($PDFfile->{"Outlines"}{"/First"}));
+    print FILE "/Last $table[2][$objects] 0 R
+";
+    print FILE ">>
+";
+    print FILE "endobj
+";
+    
+    #store the last outline entry object num and file offset
+    my @last_entry = split(/\s/, $PDFfile->{"Outlines"}{"/Last"});
+    $table[1][$objects] = $last_entry[0]; 
+    $table[1][$offsets] = tell \*FILE; 
+
+    #append modified last outline entry
+    print FILE "$table[1][$objects] 0 obj
+";
+    print FILE "<<
+";
+    print FILE "/Title $last_data->{\"/Title\"}
+";
+    print FILE "/Dest $last_data->{\"/Dest\"}
+" if(defined $last_data->{"/Dest"});
+    print FILE "/Parent $last_data->{\"/Parent\"}
+";
+    print FILE "/Prev $last_data->{\"/Prev\"}
+";
+    print FILE "/Next $table[2][$objects] 0 R
+";
+    print FILE "/First $last_data->{\"/First\"}
+" if(defined $last_data->{"/First"});
+    print FILE "/Last $last_data->{\"/Last\"}
+" if(defined $last_data->{"/Last"});
+    print FILE "/Count $last_data->{\"/Count\"}
+"if(defined $last_data->{"/Count"});
+    print FILE "/A $last_data->{\"/A\"}
+" if(defined $last_data->{"/A"});
+    print FILE "/SE $last_data->{\"/SE\"}
+" if(defined $last_data->{"/SE"});
+    print FILE ">>
+";
+    print FILE "endobj
+";
+    
+    #store the object num and offset of the related
+    #document top level outline
+    my $obj = $table[2][$objects] + 1;
+    $table[2][$offsets] = tell \*FILE;
+
+    #append related document top level outline
+    print FILE "$table[2][$objects] 0 obj
+";
+    print FILE "<<
+";
+    print FILE "/Title (Related Documents)
+"; 
+    print FILE "/Parent $last_data->{\"/Parent\"}
+";
+    print FILE "/Count ", $url_num, "
+";
+    print FILE "/First $obj 0 R
+";
+    print FILE "/Last ", $table[2][$objects] + $url_num , " 0 R
+";
+    print FILE ">>
+";
+    print FILE "endobj
+";
+    
+   
+    my $ind = 3;
+
+    #store the object nums and offsets of the new related document
+    #outlines and write them to the file (must be outline with
+    #an action eg go to specific url)
+    for $i ( 0 .. $#urls ) { 
+	$table[$ind][$objects] = $obj;  
+	$table[$ind][$offsets] = tell \*FILE; 
+	print FILE "$obj 0 obj
+";
+	print FILE "<<
+";
+	print FILE "/Title ($urls[$i][0])
+"; 
+	print FILE "/Parent $table[2][$objects] 0 R
+";
+	print FILE "/Next ", $obj + 1, " 0 R
+" if (($obj + 1) <= ($table[2][$objects] + $url_num)); 
+	print FILE "/Prev ", $obj - 1, " 0 R
+" if (($obj - 1) != ($table[2][$objects]));
+	print FILE "/A << /Type /Action
+";
+	print FILE "/S /URI
+"; 
+	print FILE "/URI ($urls[$i][1])
+"; 
+	print FILE ">>
+";
+	print FILE ">>
+";
+	print FILE "endobj
+";
+	$obj++;
+	$ind++;
+    }
+    
+    #append new X-reference table
+    my $xref_offset = tell \*FILE;   
+    xref_table(\*FILE, $url_num, @table); 
+  
+    #print trailer  
+    trailer(\*FILE, $PDFfile, $obj);
+    print FILE "$xref_offset
+";
+    print FILE "%%EOF
+"; 
+
+    close FILE;
+
+}
+
+
+#This function reads a file 'url.txt' which contains
+#two columns of data in the following format:
+#related document title    related document url
+#each array of title, url is stored in an array
+#(to obtain the title of the first related  
+#document in the file)
+#eg table[1st related document][title] 
+#(to obtain the url of the second related 
+#document in the file)
+#eg table[2nd related document][url]
+#this table is then returned to the calling 
+#function.
+sub read_file {
+
+    #create two-dimensional array for urls
+    my @urls;
+
+    #open up url.txt to start reading
+    open(URL, "$related_docs") or croak "Can't open $related_docs: $!"; 
+
+    my $counter = 0;
+
+    #read in url.txt and store into the arry
+    while (<URL>){
+	chomp;
+	if(/([^\t]*)\t(.*)/){ 
+	    push @urls, [ split ]; #split on /s into arrays of arrays
+	}
+    }
+
+    close URL;
+
+    return (@urls);
+
+}
+
+ 
+#this function takes as parameters the filehandle
+#to the pdf document, the number of related documents
+#to this pdf doc and a table of object numbers and
+#their offsets. Using this information it writes
+#(appends) a new xreference table to the pdf 
+#document. 
+
+sub xref_table  (*\$) {
+    
+    my ($fd, $num, @table) = @_;
+    my $offset;
+
+    #print the new xref table (append to file)
+    print $fd "xref
+";
+    print $fd "0 1 
+";
+    print $fd "0000000000 65535 f 
+";
+    print $fd "$table[0][$objects] 1 
+";
+    $offset = '0'x(10-length($table[0][$offsets])).$table[0][$offsets];
+    print $fd "$offset 00000 n 
+";
+    print $fd "$table[1][$objects] 1 
+"; 
+    $offset = '0'x(10-length($table[1][$offsets])).$table[1][$offsets];
+    print $fd "$offset 00000 n 
+";
+    print $fd "$table[2][$objects] ", $num + 1, " 
+"; 
+    for $i ( 2 .. ($num + 2) ) { #add 2 on because already written 2 to file
+	$offset = '0'x(10-length($table[$i][$offsets])).$table[$i][$offsets];
+	print $fd "$offset 00000 n 
+";
+    }
+    
+}
+
+
+#This function recieves as parameters the filehandle
+#to the pdf document, parsed information about the
+#document and the new size (last object number + 1)
+#of the pdf file.  Using this information it appends
+#a new trailer to the end of the pdf document.
+
+sub trailer  (*\$) {
+
+    my ($fd, $PDFfile, $new_size) = @_;
+
+    #append the new trailer to the end of the file
+    print $fd "trailer
+";
+    print $fd "<<
+";
+    print $fd "/Size ", $new_size, "
+";
+    print $fd "/Root $PDFfile->{\"Trailer\"}{\"/Root\"}
+";
+    print $fd "/Info $PDFfile->{\"Trailer\"}{\"/Info\"}
+" 
+	if (defined ($PDFfile->{"Trailer"}{"/Info"}));
+    print $fd "/ID [$PDFfile->{\"Trailer\"}{\"/ID\"}[0]$PDFfile->{\"Trailer\"}{\"/ID\"}[1]]
+"
+	if (defined ($PDFfile->{"Trailer"}{"/ID"}));
+    print $fd "/Prev $PDFfile->{\"Last_XRef_Offset\"}
+";
+    print $fd "/Encrypt $PDFfile->{\"Trailer\"}{\"/Encrypt\"}
+"
+	if (defined ($PDFfile->{"Trailer"}{"/Encrypt"}));
+    print $fd ">>
+";
+    print $fd "startxref
+";
+   
+}
+
+
+
Index: /trunk/gsdl/bin/script/indexes/buildkpi.pl
===================================================================
--- /trunk/gsdl/bin/script/indexes/buildkpi.pl	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/buildkpi.pl	(revision 1971)
@@ -0,0 +1,491 @@
+#! /user/bin/perl 
+
+#usage: perl buildkpi.pl [-R] [collection] [collection] etc
+#
+#-r or -R will remove previous index files so that you may build new ones
+#
+#The program performs the following tasks:
+#-gathers the specified collections on the command line OR
+#-gathers the directories of all the collections in the collect directory, this is all
+# the directories apart from CVS, modelcol, . and .. which are not collections.
+#-It then retrieves the archive.inf file from the archive directory of each collection
+# to obtain the unique file ID and filepath of every document in the collection
+#-Then parse through each doc.gml stored in filepath to gather information
+#-From each file collect kea phrases and/or stems
+#-Determine the number of kea phrases and stems for each document 
+#-Search for the kea phrases in the numbered phrase index. If a phrase is not there then 
+# the program will write the kea phrase to the phrase index . 
+#-Search for the kea phrases in the keyphrase to document index. If the phrase is there, 
+# it will increment the number of documents that the keyphrase appears in and replace that
+# then append the hash ID to the list of documents in the entry. If the phrase is not there 
+# then the program will write the kea phrase to the phrase index.
+#-Then write document ID, no of phrase, phrase number from index followed by number of times 
+# phrase appears into the document_keyphrase index
+
+$gsdlhome = $ENV{'GSDLHOME'};
+
+require "getopts.pl";
+&Getopts('R'); #process option arguments
+
+
+#collections may be specified in the command line
+#otherwise, all collections will be used to build
+#the indexes.  
+if(@ARGV){
+
+    @directories = @ARGV;
+
+} else { #open collect directory and get a list of all collections
+    opendir(DIR, "$gsdlhome/collect");
+    @directories = grep(!/(^\.|(CVS)|(modelcol))/, readdir(DIR));
+    closedir(DIR);
+}
+
+
+#directory to store indexes in using collection names
+$dirname = "";
+foreach $collection (sort @directories){
+    $dirname .= $collection."_";
+}
+$dirname .= "indexes";
+print STDERR "directory name: $dirname\n";
+
+#if option R remove all previous indexes
+if($opt_R == 1){ #remove indexes
+    print STDERR "\nremoving $gsdlhome/bin/script/indexes/$dirname/keyphrase_index.txt\n";
+    print STDERR "removing $gsdlhome/bin/script/indexes/$dirname/keyphrase_document.txt\n";
+    print STDERR "removing $gsdlhome/bin/script/indexes/$dirname/document_keyphrase.txt\n";
+    system("rm $gsdlhome/bin/script/indexes/$dirname/keyphrase_document.txt");   
+    system("rm $gsdlhome/bin/script/indexes/$dirname/document_keyphrase.txt"); 
+    system("rm $gsdlhome/bin/script/indexes/$dirname/keyphrase_index.txt");
+} 
+
+#create the new directory, display an error message if the directory
+#already exists.
+`mkdir --verbose $gsdlhome/bin/script/indexes/$dirname`;
+
+#for each collection specified to build indexes for
+foreach $collection (@directories){
+
+    print STDERR "\nBUILDING INDEXES FOR COLLECTION $collection\n\n";
+
+    my @filelist;
+
+    #archives.inf contains a list of unique hash ID's of each file and file paths
+    open(INFO, "$gsdlhome/collect/$collection/archives/archives.inf")
+	or die "$gsdlhome/collect/$collection/archives/archives.inf could not be opened.";
+
+    while(<INFO>){ #get each line of text from archives.inf (OID \t filepath)
+	chomp;
+	push(@filelist, $_);
+    }
+
+    foreach $file (@filelist){ #add each document to the indexes
+	build_index($file, $collection);
+    }
+}
+
+#This function opens the file in the filepath sent as an argument.  From this it obtains 
+#the kea and/or stem data, and then searches for these phrases in the file, counting and storing 
+#how many times each phrase appears. The data is then sent to function keyphrase_document 
+#with arguments hash ID, kea phrases and stem phrases to build the keyphrase_document index.
+#The function which builds the document_keyphrase index is then passed the hash ID, the kea 
+#phrases and/or the stemmed phrases and the array/s which hold the number of times each phrase
+#appears in the document so that the data it has collected can be written to document_ keyphrase
+#index.
+
+sub build_index {
+
+    my $args = shift(@_);
+    my $collection = shift(@_);
+    my ($ID, $filepath) = split(/\t/, $args);
+    my $keaS = "";
+    my $stemsS = "";
+    my @kea_phrase_counts = 0;
+    my @stem_phrase_counts = 0;
+    my $text = "";
+
+    print STDERR "\nID: $ID\n";
+    print STDERR "filepath: $filepath\n";
+
+    #open file to extract keyphrase information
+    open(FILE, "$gsdlhome/collect/$collection/archives/$filepath")
+	or die "$gsdlhome/collect/$collection/archives/$filepath could not be opened.";
+
+    #patterns to search for so that we can extract the kea information
+    my $kea_search = ".* kea=\"([^\"]*)\"";
+    my $stem_search = "stems=\"([^\"]*)\"";
+
+    while(<FILE>){ #get kea and stem data and store
+	chomp;
+	$keaS = $1 if (/$kea_search/);
+	$stemsS = $1 if (/$stem_search/);
+    }
+
+    close(FILE);
+    
+    print STDERR "Kea: $keaS\n";
+    print STDERR "stems: $stemsS\n";
+
+    my @kea = split(", ", $keaS);
+    my @stems = split(", ", $stemsS);
+
+    if(@kea && @stems){ #if the data exists
+	
+	#open the filepath to the current document
+	open(FILE, "$gsdlhome/collect/$collection/archives/$filepath")
+	    or die "$gsdlhome/collect/$collection/archives/$filepath could not be opened.";
+	
+	while(<FILE>){ #get the text
+	    chomp;
+	    $text .= $_;
+	}
+ 
+	#chop out all things in angled brackets
+	$text =~ s/(<[^>]*>)//g;
+
+	#initilise counts
+	for($i=0; $i<=$#kea; $i++){
+	    $kea_phrase_counts[$i] = 0;
+	}
+	
+	for($i=0; $i<=$#stems; $i++){
+	    $stem_phrase_counts[$i] = 0;
+	}
+
+	print STDERR "counting number of kea phrases in document...\n";
+
+	#using regular expressions generated from kea-reg and stem-reg
+	#count how many of each phrase appear in the document
+	$text_copy = $text;
+	for($i=0; $i<=$#kea; $i++){ #search for text with kea phrases
+	    my $phrase = $kea[$i];
+	    $reg = &kea_reg(split(/\s+/, $phrase));
+	    while($text_copy =~ s/$reg//i){
+		$kea_phrase_counts[$i]++; #count the number of kea phrases 
+	    } 
+	    $text_copy = $text;
+	}  
+
+	print STDERR "counting number of stemmed phrases in document...\n";
+
+	$text_copy = $text;
+	for($i=0; $i<=$#stems; $i++){ #search for text with stem phrases
+	    my $stem = $stems[$i];
+	    $reg = &stem_reg(split(/\s+/, $stem));
+	    while($text_copy =~ s/$reg//i){
+		$stem_phrase_counts[$i]++; #count the number of stem phrases
+	    } 
+	    $text_copy = $text;
+	}
+
+	
+	#write data to keyphrase_document index
+	&keyphrase_document($ID, $keaS, $stemsS); 
+	
+	#write data to document_keyphrase index
+	$kea_counts = join(", ", @kea_phrase_counts);
+	$stem_counts = join(", ", @stem_phrase_counts);
+	&document_keyphrase($ID, $keaS, $stemsS, $kea_counts, $stem_counts);
+	
+    } else { 
+	print STDERR "No kea data was found in file $filepath\n";
+    }
+
+}
+
+#returns a regular expression designed to 
+#search for stems in text
+#eg 'agri cari'
+#    agri followed by 0 or more non-whitespace characters
+#         followed by one or more whitespace OR 0 or 1 non-whitespace characters
+#    cari followed by 0 or more non-whitespace characters
+#modified from original by Stephen Lundy 
+
+sub stem_reg {
+   
+    $regexp = "";
+
+    $l = @_;
+
+    if ($l > 0) {
+        $s = shift;
+        $regexp = "$s\\S*";
+
+        if ($l-1 > 0) {
+            foreach $s (@_) {
+                $regexp .= "(\\s+|\\S?)$s\\S*";
+            }
+        }
+    }
+
+    return $regexp;
+}
+
+#returns a regular expression designed to 
+#search for phrases in text
+#eg 'agris caris'
+#    agris followed by 0 or 1 non-whitespace characters OR
+#          followed by one or more whitespace 
+#    caris followed by 0 or 1 non-whitespace characters
+#modified from original by Stephen Lundy 
+
+sub kea_reg {
+    $regexp = "";
+
+    $l = @_;
+
+    if ($l > 0) {
+        $s = shift;
+        #$regexp = "$s(\\S?)";
+	$regexp = "$s(\\s+|\\S?)";
+
+        if ($l-1 > 0) {
+            foreach $s (@_) {
+                $regexp .= "$s(\\s+|\\S?)";
+            }
+        }
+    }
+
+    return $regexp;
+}
+
+
+#This function is passed as arguments a list of kea phrases and/or stems. Its purpose is to 
+#check in the keyphrase index file for each phrase and determine whether or not an entry has
+#been made for that phrase and an index number assigned to it. If there has not been an entry
+#made then an index number is assigned to the phrase and it is written to the file.  This 
+#function is called by document_keyphrase and keyphrase_document.  Each line in the file has
+#this form:
+#-phrase index number:phrase
+#This function then returns a table of pairs of the phrases that were sent as arguments to it
+#{phrase => phrase index number}.
+ 
+sub keyphrase_index_search {
+
+    my $phrases = shift(@_); 
+    my @phrases = split(", ", $phrases);
+    my %table;
+    my $index = 1;
+    my $create_new_index = 0;
+
+    print STDERR "searching keyphrase index...\n";
+
+    #initilise table of phrases and index numbers
+    foreach $phrase (@phrases){
+	$table{"$phrase"} = "0";
+    }
+
+    #open keyphrase index for appending data and for reading
+    open(INDEX_OUT, ">>$gsdlhome/bin/script/indexes/$dirname/keyphrase_index.txt");
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/$dirname/keyphrase_index.txt")
+	or $create_new_index = 1;
+
+    if($create_new_index == 0){
+	#if the index already exists read in the phrases
+	while(<INDEX_IN>){
+	    chomp;
+	    foreach $phrase (@phrases){
+		if(/(\d+):$phrase/){
+		    $index = $1;
+		    $table{"$phrase"} = "$index";
+		}
+	    }
+	    $index++; #new starting index (one + the last index)
+	}
+
+	close(INDEX_IN);
+
+    }
+
+    #add new phrases to the phrase index
+    foreach $phrase (keys %table){
+	if($table{"$phrase"} eq "0"){
+	    print INDEX_OUT "$index:$phrase\n";
+	    $table{"$phrase"} = "$index"; 
+	    $index++;
+	}
+    }
+
+    close(INDEX_OUT);
+    return %table;
+}
+
+#This function is passed as arguments file hash ID and a list of kea phrases and/or stems
+#that exist for that particular file.  Its purpose is to write to the keyphrase_document
+#index a line for the document it has been sent:
+#-phrase index number:number of documents it appears in|ID
+sub keyphrase_document{
+
+    my ($ID, $kea, $stems) = @_;
+    my $text = ""; 
+    my @textlist;
+    my $create_new_index = 0;
+
+    print STDERR "writing to keyphrase_document.txt...\n";
+
+    #get table of phrases and phrase indexes 
+    my %table = keyphrase_index_search($kea.", ".$stems); 
+    
+  
+    #open index for reading
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/$dirname/keyphrase_document.txt")
+	or $create_new_index = 1;
+
+    #read in document if file exists
+    if($create_new_index == 0){
+
+	while(<INDEX_IN>){
+	    $text .= $_;
+	}
+
+	close(INDEX_IN);
+
+	#split text into lines
+	@textlist = split(/\n/, $text);
+
+    } 
+
+    #open index for output
+    open(INDEX_OUT, ">$gsdlhome/bin/script/indexes/$dirname/keyphrase_document.txt");
+
+    if($create_new_index == 0){ #amend existing index
+	
+	foreach $line (@textlist){
+	    foreach $phrase (keys %table){
+		if($line =~ /(\d+):(\d+)(.*)/){ #all lines of this form
+		    $index = $1;
+		    if($table{"$phrase"} eq "$index") { #if phrase exists in index
+			$ids = $3; #get all doc IDs for that keyphrase
+			if($ids !~ /$ID/){ #if doc ID not already included
+			    $num_docs = $2;
+			    $num_docs++; #increment number of docs
+			    $line = "$index:$num_docs$3|$ID"; #line to append to index
+			    $table{"$phrase"} = "0"; 
+			}
+		    }
+		}
+	    }
+	    print INDEX_OUT "$line\n";
+	}
+    }
+
+    #add new phrases to the index
+    foreach $phrase (keys %table){ #write 'phrase index:1:file ID
+	if($table{"$phrase"} ne "0"){
+	    my $line = "$table{$phrase}:1:$ID";
+	    print INDEX_OUT "$line\n"; 
+	}
+    }
+
+    close(INDEX_OUT);
+
+}
+
+#This function is passed as arguments file hash ID and a list of kea phrases and/or stems
+#that exist for that particular file and a list of the number of times each kea and/or stem
+#phrase appear in that document.  Its purpose is to write to the document_keyphrase
+#index a line for the document it has been sent:
+#-file ID:number of phrases and/or stems appear in the document
+#      |pairs of 'phrase index,number of times the phrase appears in the document' 
+sub document_keyphrase {
+
+    my ($ID, $keaS, $stemsS, $kea_c, $stem_c) = @_;
+    my $text = "";
+    my @textlist;
+    my %phrases;
+    my $create_new_index = 0;
+
+    print STDERR "writing to document_keyphrase.txt...\n";
+
+    #split phrase counts into arrays
+    my @kea_counts = split(", ", $kea_c);
+    my @stem_counts = split(", ", $stem_c);
+  
+    #get table of phrases and phrase indexes
+    my %table = keyphrase_index_search($keaS.", ".$stemsS);
+
+    #split phrases into arrays
+    my @kea = split(", ", $keaS);
+    my @stems = split(", ", $stemsS);
+
+    #build new phrases dictionary
+    for($i=0; $i<=$#kea; $i++){
+	my $phrase = $table{"$kea[$i]"};
+	if($kea_counts[$i] > 0){
+	    $phrases{"$phrase"} = "$kea_counts[$i]";
+	} else {
+	    $phrases{"$phrase"} = 1;
+	}
+    } 
+    for($i=0; $i<=$#stems; $i++){
+	my $phrase = $table{"$stems[$i]"};
+	if($stem_counts[$i] > 0){
+	    $phrases{"$phrase"} = "$stem_counts[$i]";
+	} else {
+	    $phrases{"$phrase"} = 1;
+	}
+    }   
+    my @num = keys %phrases;
+    my $phrasenum = $#num + 1; #number of phrases in doc
+
+    #open index for reading
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/$dirname/document_keyphrase.txt")
+	or $create_new_index = 1;
+
+     
+    if($create_new_index == 0){ #index doesn't need to be created
+
+	while(<INDEX_IN>){
+	    $text .= $_;
+	}
+
+	close(INDEX_IN);
+	
+	#split text into lines
+	@textlist = split(/\n/, $text);
+
+    }  
+
+
+    #must write this line to the file
+    #document ID:num of phrases|phrase index, number of times phrases appears
+    my $newline = "$ID:$phrasenum";
+    foreach $phrase (keys %phrases){
+	$newline .= "|$phrase,$phrases{$phrase}";
+    }
+
+    #open index for output
+    open(INDEX_OUT, ">$gsdlhome/bin/script/indexes/$dirname/document_keyphrase.txt");
+
+    if($create_new_index == 1){ #create a new index
+
+	print INDEX_OUT "$newline\n";
+
+    } else {
+
+	#if ID is already in the file write line overtop incase
+	#someone has modified the file.  Otherwise add the line
+	#to the end of the file
+	my $found = 0;
+
+	foreach $line (@textlist){
+	    if($line =~ /([^:]+):(.*)/){ #all lines should follow this pattern
+		$id = $1;
+		if($ID eq $id){ #id is already in the file
+		    print INDEX_OUT "$newline\n"; #print line overtop
+		    $found = 1;
+		} else {
+		    print INDEX_OUT "$line\n"; #print old line out
+		}
+	    }
+	}
+
+	print INDEX_OUT "$newline\n" if ($found == 0); #append new line to end of file 
+
+    }
+
+    close(INDEX_OUT);
+
+}
+
Index: /trunk/gsdl/bin/script/indexes/buildkpiK.pl
===================================================================
--- /trunk/gsdl/bin/script/indexes/buildkpiK.pl	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/buildkpiK.pl	(revision 1971)
@@ -0,0 +1,411 @@
+#! /user/bin/perl 
+
+#usage: perl buildkpiK.pl [-R] [collection] [collection] etc
+#
+#-r or -R will remove previous index files so that you may build new ones
+#
+#The program performs the following tasks:
+#-gathers the specified collections on the command line OR
+#-gathers the directories of all the collections in the collect directory, this is all
+# the directories apart from CVS, modelcol, . and .. which are not collections.
+#-It then retrieves the archive.inf file from the archive directory of each collection
+# to obtain the unique file ID and filepath of every document in the collection
+#-Then parse through each doc.gml stored in filepath to gather information
+#-From each file collect kea phrases. 
+#-Determine the number of kea phrases for each document 
+#-Search for the kea phrases in the numbered phrase index. If a phrase is not there then 
+# the program will write the kea phrase to the phrase index . 
+#-Search for the kea phrases in the keyphrase to document index. If the phrase is there, 
+# it will increment the number of documents that the keyphrase appears in and replace that
+# then append the hash ID to the list of documents in the entry. If the phrase is not there 
+# then the program will write the kea phrase to the phrase index.
+#-Then write document ID, no of phrase, phrase number from index followed by number of times 
+# phrase appears into the document_keyphrase index
+
+$gsdlhome = $ENV{'GSDLHOME'};
+$collection;
+
+require "getopts.pl";
+&Getopts('R'); #process option arguments
+
+#if option R remove all previous indexes
+if($opt_R == 1){ #remove indexes
+    print STDERR "\nremoving $gsdlhome/bin/script/indexes/keyphrase_index.txt\n";
+    print STDERR "removing $gsdlhome/bin/script/indexes/keyphrase_document.txt\n";
+    print STDERR "removing $gsdlhome/bin/script/indexes/document_keyphrase.txt\n";
+    system("rm $gsdlhome/bin/script/indexes/keyphrase_document.txt");   
+    system("rm $gsdlhome/bin/script/indexes/document_keyphrase.txt"); 
+    system("rm $gsdlhome/bin/script/indexes/keyphrase_index.txt");
+}
+
+#collections may be specified in the command line
+#otherwise, all collections will be used to build
+#the indexes.  
+if(@ARGV){
+
+    @directories = @ARGV;
+
+} else { #open collect directory and get a list of all collections
+    opendir(DIR, "$gsdlhome/collect");
+    @directories = grep(!/(^\.|(CVS)|(modelcol))/, readdir(DIR));
+    closedir(DIR);
+}
+
+#for each collection specified to build indexes for
+foreach $collection (@directories){
+
+    my @filelist;
+
+    #archives.inf contains a list of unique hash ID's of each file and file paths
+    open(INFO, "$gsdlhome/collect/$collection/archives/archives.inf")
+	or die "$gsdlhome/collect/$collection/archives/archives.inf could not be opened.";
+
+    while(<INFO>){ #get each line of text from archives.inf (OID \t filepath)
+	chomp;
+	push(@filelist, $_);
+    }
+
+    foreach $file (@filelist){ #add each document to the indexes
+	build_index($file, $collection);
+    }
+}
+
+#This function opens the file in the filepath sent as an argument.  From this it obtains 
+#the kea data, and then searches for these phrases in the file, counting and storing 
+#how many times each phrase appears. The data is then sent to function keyphrase_document 
+#with arguments hash ID, kea phrases to build the keyphrase_document index.
+#The function which builds the document_keyphrase index is then passed the hash ID, the kea 
+#phrases and the array/s which hold the number of times each phrase
+#appears in the document so that the data it has collected can be written to document_ keyphrase
+#index.
+
+sub build_index {
+
+    my $args = shift(@_);
+    my $collection = shift(@_);
+    my ($ID, $filepath) = split(/\t/, $args);
+    my $keaS = "";
+    my @kea_phrase_counts = 0;
+    my $text = "";
+
+    print STDERR "\nID: $ID\n";
+    print STDERR "filepath: $filepath\n";
+
+    #open file to extract keyphrase information
+    open(FILE, "$gsdlhome/collect/$collection/archives/$filepath")
+	or die "$gsdlhome/collect/$collection/archives/$filepath could not be opened.";
+
+    #patterns to search for so that we can extract the kea information
+    my $kea_search = ".* kea=\"([^\"]*)\"";
+
+    while(<FILE>){ #get kea and stem data and store
+	chomp;
+	$keaS = $1 if (/$kea_search/);
+    }
+
+    close(FILE);
+    
+    print STDERR "Kea: $keaS\n";
+
+    my @kea = split(", ", $keaS);
+
+    if(@kea){ #if the data exists
+	
+	#open the filepath to the current document
+	open(FILE, "$gsdlhome/collect/$collection/archives/$filepath")
+	    or die "$gsdlhome/collect/$collection/archives/$filepath could not be opened.";
+	
+	while(<FILE>){ #get the text
+	    chomp;
+	    $text .= $_;
+	}
+ 
+	#chop out all things in angled brackets
+	$text =~ s/(<[^>]*>)//g;
+
+	#initilise counts
+	for($i=0; $i<=$#kea; $i++){
+	    $kea_phrase_counts[$i] = 0;
+	}
+	
+	
+	#using regular expressions generated from kea-reg 
+	#count how many of each phrase appear in the document
+	$text_copy = $text;
+	for($i=0; $i<=$#kea; $i++){ #search for text with kea phrases
+	    my $phrase = $kea[$i];
+	    $reg = &kea_reg(split(/\s+/, $phrase));
+	    while($text_copy =~ s/$reg//i){
+		$kea_phrase_counts[$i]++; #count the number of kea phrases 
+	    } 
+	    $text_copy = $text;
+	}  
+	
+	#write data to keyphrase_document index
+	&keyphrase_document($ID, $keaS); 
+	
+	#write data to document_keyphrase index
+	$kea_counts = join(", ", @kea_phrase_counts);
+	&document_keyphrase($ID, $keaS, $kea_counts);
+	
+    } else { 
+	print STDERR "No kea data was found in file $filepath\n";
+    }
+
+}
+
+
+#returns a regular expression designed to 
+#search for phrases in text
+#eg 'agris caris'
+#    agris followed by 0 or 1 non-whitespace characters OR
+#          followed by one or more whitespace 
+#    caris followed by 0 or 1 non-whitespace characters
+#modified from original by Stephen Lundy 
+
+sub kea_reg {
+    $regexp = "";
+
+    $l = @_;
+
+    if ($l > 0) {
+        $s = shift;
+        #$regexp = "$s(\\S?)";
+	$regexp = "$s(\\s+|\\S?)";
+
+        if ($l-1 > 0) {
+            foreach $s (@_) {
+                $regexp .= "$s(\\s+|\\S?)";
+            }
+        }
+    }
+
+    return $regexp;
+}
+
+
+#This function is passed as arguments a list of kea phrases and/or stems. Its purpose is to 
+#check in the keyphrase index file for each phrase and determine whether or not an entry has
+#been made for that phrase and an index number assigned to it. If there has not been an entry
+#made then an index number is assigned to the phrase and it is written to the file.  This 
+#function is called by document_keyphrase and keyphrase_document.  Each line in the file has
+#this form:
+#-phrase index number:phrase
+#This function then returns a table of pairs of the phrases that were sent as arguments to it
+#{phrase => phrase index number}.
+ 
+sub keyphrase_index_search {
+
+    my $phrases = shift(@_);
+    my @phrases = split(", ", $phrases);
+    my %table;
+    my $index = 1;
+    my $create_new_index = 0;
+
+    print STDERR "searching keyphrase index...\n";
+
+    #initilise table of phrases and index numbers
+    foreach $phrase (@phrases){
+	$table{"$phrase"} = "0";
+    }
+
+    #open keyphrase index for appending data and for reading
+    open(INDEX_OUT, ">>$gsdlhome/bin/script/indexes/keyphrase_index.txt");
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/keyphrase_index.txt")
+	or $create_new_index = 1;
+
+    if($create_new_index == 0){
+	#if the index already exists read in the phrases
+	while(<INDEX_IN>){
+	    chomp;
+	    foreach $phrase (@phrases){
+		if(/(\d+):$phrase/){
+		    $index = $1;
+		    $table{"$phrase"} = "$index";
+		}
+	    }
+	    $index++; #new starting index (one + the last index)
+	}
+
+	close(INDEX_IN);
+
+    }
+
+    #add new phrases to the phrase index
+    foreach $phrase (keys %table){
+	if($table{"$phrase"} eq "0"){
+	    print INDEX_OUT "$index:$phrase\n";
+	    $table{"$phrase"} = "$index"; 
+	    $index++;
+	}
+    }
+
+    close(INDEX_OUT);
+    return %table;
+}
+
+#This function is passed as arguments file hash ID and a list of kea phrases
+#that exist for that particular file.  Its purpose is to write to the keyphrase_document
+#index a line for the document it has been sent:
+#-phrase index number:number of documents it appears in|ID
+sub keyphrase_document{
+
+    my ($ID, $kea) = @_;
+    my $text = ""; 
+    my @textlist;
+    my $create_new_index = 0;
+
+    print STDERR "writing to keyphrase_document.txt...\n";
+
+    #get table of phrases and phrase indexes 
+    my %table = keyphrase_index_search($kea); 
+    
+  
+    #open index for reading
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/keyphrase_document.txt")
+	or $create_new_index = 1;
+
+    #read in document if file exists
+    if($create_new_index == 0){
+
+	while(<INDEX_IN>){
+	    $text .= $_;
+	}
+
+	close(INDEX_IN);
+
+	#split text into lines
+	@textlist = split(/\n/, $text);
+
+    } 
+
+    #open index for output
+    open(INDEX_OUT, ">$gsdlhome/bin/script/indexes/keyphrase_document.txt");
+
+    if($create_new_index == 0){ #amend existing index
+	
+	foreach $line (@textlist){
+	    foreach $phrase (keys %table){
+		if($line =~ /(\d+):(\d+)(.*)/){ #all lines of this form
+		    $index = $1;
+		    if($table{"$phrase"} eq "$index") { #if phrase exists in index
+			$ids = $3; #get all doc IDs for that keyphrase
+			if($ids !~ /$ID/){ #if doc ID not already included
+			    $num_docs = $2;
+			    $num_docs++; #increment number of docs
+			    $line = "$index:$num_docs$3|$ID"; #line to append to index
+			    $table{"$phrase"} = "0"; 
+			}
+		    }
+		}
+	    }
+	    print INDEX_OUT "$line\n";
+	}
+    }
+
+    #add new phrases to the index
+    foreach $phrase (keys %table){ #write 'phrase index:1:file ID
+	if($table{"$phrase"} ne "0"){
+	    my $line = "$table{$phrase}:1:$ID";
+	    print INDEX_OUT "$line\n"; 
+	}
+    }
+
+    close(INDEX_OUT);
+
+}
+
+#This function is passed as arguments file hash ID and a list of kea phrases and/or stems
+#that exist for that particular file and a list of the number of times each kea and/or stem
+#phrase appear in that document.  Its purpose is to write to the document_keyphrase
+#index a line for the document it has been sent:
+#-file ID:number of phrases and/or stems appear in the document
+#      |pairs of 'phrase index,number of times the phrase appears in the document' 
+sub document_keyphrase {
+
+    my ($ID, $keaS, $kea_c) = @_;
+    my $text = "";
+    my @textlist;
+    my %phrases;
+    my $create_new_index = 0;
+
+    print STDERR "writing to document_keyphrase.txt...\n";
+
+    #split phrase counts into arrays
+    my @kea_counts = split(", ", $kea_c);
+  
+    #get table of phrases and phrase indexes
+    my %table = keyphrase_index_search($keaS);
+
+    #split phrases into arrays
+    my @kea = split(", ", $keaS);
+
+    #build new phrases dictionary
+    for($i=0; $i<=$#kea; $i++){
+	my $phrase = $table{"$kea[$i]"};
+	$phrases{"$phrase"} = "$kea_counts[$i]";
+    } 
+   
+    my @num = keys %phrases;
+    my $phrasenum = $#num + 1; #number of phrases in doc
+
+    #open index for reading
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/document_keyphrase.txt")
+	or $create_new_index = 1;
+
+     
+    if($create_new_index == 0){ #index doesn't need to be created
+
+	while(<INDEX_IN>){
+	    $text .= $_;
+	}
+
+	close(INDEX_IN);
+	
+	#split text into lines
+	@textlist = split(/\n/, $text);
+
+    }  
+
+
+    #must write this line to the file
+    #'document ID:num of phrases|phrase index, number of times phrases appears
+    my $newline = "$ID:$phrasenum";
+    foreach $phrase (keys %phrases){
+	$newline .= "|$phrase,$phrases{$phrase}";
+    }
+
+    #open index for output
+    open(INDEX_OUT, ">$gsdlhome/bin/script/indexes/document_keyphrase.txt");
+
+    if($create_new_index == 1){ #create a new index
+
+	print INDEX_OUT "$newline\n";
+
+    } else {
+
+	#if ID is already in the file write line overtop incase
+	#someone has modified the file.  Otherwise add the line
+	#to the end of the file
+	my $found = 0;
+
+	foreach $line (@textlist){
+	    if($line =~ /([^:]+):(.*)/){ #all lines should follow this pattern
+		$id = $1;
+		if($ID eq $id){ #id is already in the file
+		    print INDEX_OUT "$newline\n"; #print line overtop
+		    $found = 1;
+		} else {
+		    print INDEX_OUT "$line\n"; #print old line out
+		}
+	    }
+	}
+
+	print INDEX_OUT "$newline\n" if ($found == 0); #append new line to end of file 
+
+    }
+
+    close(INDEX_OUT);
+
+}
+
Index: /trunk/gsdl/bin/script/indexes/buildkpiS.pl
===================================================================
--- /trunk/gsdl/bin/script/indexes/buildkpiS.pl	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/buildkpiS.pl	(revision 1971)
@@ -0,0 +1,420 @@
+#! /user/bin/perl 
+
+#usage: perl buildkpiS.pl [-R] [collection] [collection] etc
+#
+#-r or -R will remove previous index files so that you may build new ones
+#
+#The program performs the following tasks:
+#-gathers the specified collections on the command line OR
+#-gathers the directories of all the collections in the collect directory, this is all
+# the directories apart from CVS, modelcol, . and .. which are not collections.
+#-It then retrieves the archive.inf file from the archive directory of each collection
+# to obtain the unique file ID and filepath of every document in the collection
+#-Then parse through each doc.gml stored in filepath to gather information
+#-From each file collect stems of kea keyphrases.
+#-Determine the number of keyphrase stems for each document 
+#-Search for the keyphrase stems in the numbered phrase index. If a phrase is not there then 
+# the program will write the keyphrase stem to the phrase index . 
+#-Search for the keyphrase stem in the keyphrase to document index. If the stem is there, 
+# it will increment the number of documents that the keyphrase stem appears in and replace that
+# then append the hash ID to the list of documents in the entry. If the stem is not there 
+# then the program will write the stem to the phrase index.
+#-Then write document ID, no of phrase, phrase number from index followed by number of times 
+# phrase appears into the document_keyphrase index
+
+$gsdlhome = $ENV{'GSDLHOME'};
+$collection;
+
+require "getopts.pl";
+&Getopts('R'); #process option arguments
+
+#if option R remove all previous indexes
+if($opt_R == 1){ #remove indexes
+    print STDERR "\nremoving $gsdlhome/bin/script/indexes/keyphrase_index.txt\n";
+    print STDERR "removing $gsdlhome/bin/script/indexes/keyphrase_document.txt\n";
+    print STDERR "removing $gsdlhome/bin/script/indexes/document_keyphrase.txt\n";
+    system("rm $gsdlhome/bin/script/indexes/keyphrase_document.txt");   
+    system("rm $gsdlhome/bin/script/indexes/document_keyphrase.txt"); 
+    system("rm $gsdlhome/bin/script/indexes/keyphrase_index.txt");
+}
+
+#collections may be specified in the command line
+#otherwise, all collections will be used to build
+#the indexes.  
+if(@ARGV){
+
+    @directories = @ARGV;
+
+} else { #open collect directory and get a list of all collections
+    opendir(DIR, "$gsdlhome/collect");
+    @directories = grep(!/(^\.|(CVS)|(modelcol))/, readdir(DIR));
+    closedir(DIR);
+}
+
+#for each collection specified to build indexes for
+foreach $collection (@directories){
+
+    my @filelist;
+
+    #archives.inf contains a list of unique hash ID's of each file and file paths
+    open(INFO, "$gsdlhome/collect/$collection/archives/archives.inf")
+	or die "$gsdlhome/collect/$collection/archives/archives.inf could not be opened.";
+
+    while(<INFO>){ #get each line of text from archives.inf (OID \t filepath)
+	chomp;
+	push(@filelist, $_);
+    }
+
+    foreach $file (@filelist){ #add each document to the indexes
+	build_index($file, $collection);
+    }
+}
+
+#This function opens the file in the filepath sent as an argument.  From this it obtains 
+#the kea and/or stem data, and then searches for these phrases in the file, counting and storing 
+#how many times each phrase appears. The data is then sent to function keyphrase_document 
+#with arguments hash ID, kea phrases and stem phrases to build the keyphrase_document index.
+#The function which builds the document_keyphrase index is then passed the hash ID, the kea 
+#phrases and/or the stemmed phrases and the array/s which hold the number of times each phrase
+#appears in the document so that the data it has collected can be written to document_ keyphrase
+#index.
+
+sub build_index {
+
+    my $args = shift(@_);
+    my $collection = shift(@_);
+    my ($ID, $filepath) = split(/\t/, $args);
+    my $stemsS = "";
+    my @stem_phrase_counts = 0;
+    my $text = "";
+
+    print STDERR "\nID: $ID\n";
+    print STDERR "filepath: $filepath\n";
+
+    #open file to extract keyphrase information
+    open(FILE, "$gsdlhome/collect/$collection/archives/$filepath")
+	or die "$gsdlhome/collect/$collection/archives/$filepath could not be opened.";
+
+    #patterns to search for so that we can extract the kea information
+    my $stem_search = "stems=\"([^\"]*)\"";
+
+    while(<FILE>){ #get kea and stem data and store
+	chomp;
+	$stemsS = $1 if (/$stem_search/);
+    }
+
+    close(FILE);
+    
+    print STDERR "stems: $stemsS\n";
+
+    my @stems = split(", ", $stemsS);
+
+    if(@stems){ #if the data exists
+	
+	#open the filepath to the current document
+	open(FILE, "$gsdlhome/collect/$collection/archives/$filepath")
+	    or die "$gsdlhome/collect/$collection/archives/$filepath could not be opened.";
+	
+	while(<FILE>){ #get the text
+	    chomp;
+	    $text .= $_;
+	}
+ 
+	#chop out all things in angled brackets
+	$text =~ s/(<[^>]*>)//g;
+
+	#initilise counts
+	for($i=0; $i<=$#stems; $i++){
+	    $stem_phrase_counts[$i] = 0;
+	}
+	
+	#using regular expressions generated from stem-reg
+	#count how many of each phrase appear in the document
+	
+	$text_copy = $text;
+	for($i=0; $i<=$#stems; $i++){ #search for text with stem phrases
+	    my $stem = $stems[$i];
+	    $reg = &stem_reg(split(/\s+/, $stem));
+	    while($text_copy =~ s/$reg//i){
+		$stem_phrase_counts[$i]++; #count the number of stem phrases
+	    } 
+	    $text_copy = $text;
+	}
+
+	
+	#write data to keyphrase_document index
+	&keyphrase_document($ID, $stemsS); 
+	
+	#write data to document_keyphrase index
+	$stem_counts = join(", ", @stem_phrase_counts);
+	&document_keyphrase($ID, $stemsS, $stem_counts);
+	
+    } else { 
+	print STDERR "No stem data was found in file $filepath\n";
+    }
+
+}
+
+#returns a regular expression designed to 
+#search for stems in text
+#eg 'agri cari'
+#    agri followed by 0 or more non-whitespace characters
+#         followed by one or more whitespace OR 0 or 1 non-whitespace characters
+#    cari followed by 0 or more non-whitespace characters
+#modified from original by Stephen Lundy 
+
+sub stem_reg {
+   
+    $regexp = "";
+
+    $l = @_;
+
+    if ($l > 0) {
+        $s = shift;
+        $regexp = "$s\\S*";
+
+        if ($l-1 > 0) {
+            foreach $s (@_) {
+                $regexp .= "(\\s+|\\S?)$s\\S*";
+            }
+        }
+    }
+
+    return $regexp;
+}
+
+
+
+#This function is passed as arguments a list of kea phrase stems. Its purpose is to 
+#check in the keyphrase index file for each phrase and determine whether or not an entry has
+#been made for that phrase and an index number assigned to it. If there has not been an entry
+#made then an index number is assigned to the phrase and it is written to the file.  This 
+#function is called by document_keyphrase and keyphrase_document.  Each line in the file has
+#this form:
+#-phrase index number:phrase
+#This function then returns a table of pairs of the phrases that were sent as arguments to it
+#{phrase => phrase index number}.
+ 
+sub keyphrase_index_search {
+
+    my $phrases = shift(@_);
+    my @phrases = split(", ", $phrases);
+    my %table;
+    my $index = 1;
+    my $create_new_index = 0;
+
+    print STDERR "searching keyphrase index...\n";
+
+    #initilise table of phrases and index numbers
+    foreach $phrase (@phrases){
+	$table{"$phrase"} = "0";
+    }
+
+    #open keyphrase index for appending data and for reading
+    open(INDEX_OUT, ">>$gsdlhome/bin/script/indexes/keyphrase_index.txt");
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/keyphrase_index.txt")
+	or $create_new_index = 1;
+
+    if($create_new_index == 0){
+	#if the index already exists read in the phrases
+	while(<INDEX_IN>){
+	    chomp;
+	    foreach $phrase (@phrases){
+		if(/(\d+):$phrase/){
+		    $index = $1;
+		    $table{"$phrase"} = "$index";
+		}
+	    }
+	    $index++; #new starting index (one + the last index)
+	}
+
+	close(INDEX_IN);
+
+    }
+
+    #add new phrases to the phrase index
+    foreach $phrase (keys %table){
+	if($table{"$phrase"} eq "0"){
+	    print INDEX_OUT "$index:$phrase\n";
+	    $table{"$phrase"} = "$index"; 
+	    $index++;
+	}
+    }
+
+    close(INDEX_OUT);
+    return %table;
+}
+
+#This function is passed as arguments file hash ID and a list of kea phrases and/or stems
+#that exist for that particular file.  Its purpose is to write to the keyphrase_document
+#index a line for the document it has been sent:
+#-phrase index number:number of documents it appears in|ID
+sub keyphrase_document{
+
+    my ($ID, $stems) = @_;
+    my $text = ""; 
+    my @textlist;
+    my $create_new_index = 0;
+
+    print STDERR "writing to keyphrase_document.txt...\n";
+
+    #get table of phrases and phrase indexes 
+    my %table = keyphrase_index_search($stems); 
+    
+  
+    #open index for reading
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/keyphrase_document.txt")
+	or $create_new_index = 1;
+
+    #read in document if file exists
+    if($create_new_index == 0){
+
+	while(<INDEX_IN>){
+	    $text .= $_;
+	}
+
+	close(INDEX_IN);
+
+	#split text into lines
+	@textlist = split(/\n/, $text);
+
+    } 
+
+    #open index for output
+    open(INDEX_OUT, ">$gsdlhome/bin/script/indexes/keyphrase_document.txt");
+
+    if($create_new_index == 0){ #amend existing index
+	
+	foreach $line (@textlist){
+	    foreach $phrase (keys %table){
+		if($line =~ /(\d+):(\d+)(.*)/){ #all lines of this form
+		    $index = $1;
+		    if($table{"$phrase"} eq "$index") { #if phrase exists in index
+			$ids = $3; #get all doc IDs for that keyphrase
+			if($ids !~ /$ID/){ #if doc ID not already included
+			    $num_docs = $2;
+			    $num_docs++; #increment number of docs
+			    $line = "$index:$num_docs$3|$ID"; #line to append to index
+			    $table{"$phrase"} = "0"; 
+			}
+		    }
+		}
+	    }
+	    print INDEX_OUT "$line\n";
+	}
+    }
+
+    #add new phrases to the index
+    foreach $phrase (keys %table){ #write 'phrase index:1:file ID
+	if($table{"$phrase"} ne "0"){
+	    my $line = "$table{$phrase}:1:$ID";
+	    print INDEX_OUT "$line\n"; 
+	}
+    }
+
+    close(INDEX_OUT);
+
+}
+
+#This function is passed as arguments file hash ID and a list of kea phrase stems
+#that exist for that particular file and a list of the number of times each stem
+#phrase appear in that document.  Its purpose is to write to the document_keyphrase
+#index a line for the document it has been sent:
+#-file ID:number of phrases and/or stems appear in the document
+#      |pairs of 'phrase index,number of times the phrase appears in the document' 
+sub document_keyphrase {
+
+    my ($ID, $stemsS, $stem_c) = @_;
+    my $text = "";
+    my @textlist;
+    my %phrases;
+    my $create_new_index = 0;
+
+    print STDERR "writing to document_keyphrase.txt...\n";
+
+    #split phrase counts into arrays
+    my @stem_counts = split(", ", $stem_c);
+  
+    #get table of phrases and phrase indexes
+    my %table = keyphrase_index_search($stemsS);
+
+    #split phrases into arrays
+    my @stems = split(", ", $stemsS);
+
+    #build new phrases dictionary
+    for($i=0; $i<=$#stems; $i++){
+	my $phrase = $table{"$stems[$i]"};
+	$phrases{"$phrase"} = "$stem_counts[$i]";
+    }   
+    my @num = keys %phrases;
+    my $phrasenum = $#num + 1; #number of phrases in doc
+
+    #open index for reading
+    open(INDEX_IN, "$gsdlhome/bin/script/indexes/document_keyphrase.txt")
+	or $create_new_index = 1;
+
+     
+    if($create_new_index == 0){ #index doesn't need to be created
+
+	while(<INDEX_IN>){
+	    $text .= $_;
+	}
+
+	close(INDEX_IN);
+	
+	#split text into lines
+	@textlist = split(/\n/, $text);
+
+    }  
+
+
+    #must write this line to the file
+    #'document ID:num of phrases|phrase index, number of times phrases appears
+    my $newline = "$ID:$phrasenum";
+    foreach $phrase (keys %phrases){
+	$newline .= "|$phrase,$phrases{$phrase}";
+    }
+
+    #open index for output
+    open(INDEX_OUT, ">$gsdlhome/bin/script/indexes/document_keyphrase.txt");
+
+    if($create_new_index == 1){ #create a new index
+
+	print INDEX_OUT "$newline\n";
+
+    } else {
+
+	#if ID is already in the file write line overtop incase
+	#someone has modified the file.  Otherwise add the line
+	#to the end of the file
+	my $found = 0;
+
+	foreach $line (@textlist){
+	    if($line =~ /([^:]+):(.*)/){ #all lines should follow this pattern
+		$id = $1;
+		if($ID eq $id){ #id is already in the file
+		    print INDEX_OUT "$newline\n"; #print line overtop
+		    $found = 1;
+		} else {
+		    print INDEX_OUT "$line\n"; #print old line out
+		}
+	    }
+	}
+
+	print INDEX_OUT "$newline\n" if ($found == 0); #append new line to end of file 
+
+    }
+
+    close(INDEX_OUT);
+
+}
+
+
+
+
+
+
+
+
+
+
Index: /trunk/gsdl/bin/script/indexes/relation.pl
===================================================================
--- /trunk/gsdl/bin/script/indexes/relation.pl	(revision 1971)
+++ /trunk/gsdl/bin/script/indexes/relation.pl	(revision 1971)
@@ -0,0 +1,414 @@
+#!/usr/bin/perl
+
+#data structures used:
+#-document_keyphrase
+#%document_phrases = ("hashID" => {"phrase" => "number of occurrences"})
+#-keyphrase_document 
+#%phrases_document = ("phrase" => "no. of docs phrase occurs in")
+
+#after calculation relational data, it will amend gml files
+#to include this data while writing to a file ID_relatedlinks.txt
+#the html links of the related files
+#if option p is set then the user wishes to add the related documents
+#as bookmarks to the pdf file
+
+require "getopts.pl";
+&Getopts('N:P'); #process option arguments
+
+
+$gsdlhome = $ENV{'GSDLHOME'};
+@directories; #list of directories for the collections
+%phrases_document; #hash storing phrase index => no. of documents with phrase in it
+%document_phrases; #hash of hashes ID => {phrase number => no. of phrases in ID}
+$N = 0; #number of documents in the index (presumably in the collection)
+%cosine_matrix; #2-dimensional matrix, for each pair of documents stores a cosine measure
+$number_of_files = 1; #by default the top related file is returned
+$do_pdfs = 0;
+
+if($opt_N =~ /(\d)+/){ #if flag is set then return top N docs
+    $number_of_files = $opt_N;
+}
+
+#get server name and httpprefix
+$httpprefix;
+$servername = "nzdl2.cs.waikato.ac.nz"; #should be localhost
+
+if($opt_P == 1){ #if flag is set 
+    $do_pdfs = 1;
+    
+    #get the httpprefix from gsdlsite.cfg
+    open(CFG, "$gsdlhome/cgi-bin/gsdlsite.cfg") 
+	or die "$gsdlhome/cgi-bin/gsdlsite.cfg could not be opened";
+    
+    while(<CFG>){
+	chomp;
+	if(/httpprefix \/(.+)/){
+	    $httpprefix = $1; 
+	}
+    }
+    close CFG;
+}
+
+if(@ARGV){
+
+    @directories = @ARGV;
+
+} else { #open collect directory and get a list of all collections
+    opendir(DIR, "$gsdlhome/collect");
+    @directories = grep(!/(^\.|(CVS)|(modelcol))/, readdir(DIR));
+    closedir(DIR);
+}
+
+
+
+#get the name of the directory the index will be stored in
+$dirname = "";
+foreach $collection (sort @directories){
+    $dirname .= $collection."_";
+}
+$dirname .= "indexes";
+print STDERR "directory name: $dirname\n";
+
+#open keyphrases_document.txt
+open(KEY_FILE, "$gsdlhome/bin/script/indexes/$dirname/keyphrase_document.txt") 
+    or die "$gsdlhome/bin/script/indexes/$dirname/keyphrase_document.txt could not be opened";
+
+print STDERR "\nreading keyphrase_document.txt...\n";
+
+#read a list of phrase indexes and number of documents that phrase appears in 
+while(<KEY_FILE>){
+    chomp;
+    if(/(\d+)\:(\d+)(.*)/){ #all lines should be of this form
+	my $phrase_index = $1;
+	my $doc_num = $2;
+	$phrases_document{"$phrase_index"} = "$doc_num"; #build keyphrase hash
+    }
+}
+
+close(KEY_FILE); 
+
+print STDERR "\nreading document_keyphrase.txt...\n";
+
+#open document_keyphrases.txt
+open(DOC_FILE, "$gsdlhome/bin/script/indexes/$dirname/document_keyphrase.txt") 
+    or die "$gsdlhome/bin/script/indexes/$dirname/document_keyphrase.txt could not be opened";
+
+#read a list of documents and the phrases that appear in them (& how many times they appear)
+while(<DOC_FILE>){
+    chomp;
+    my %document;
+    if(/(\w+)\:(\d+)((\|\d+,\d+)+)/){ #every line in the index of this form
+	my $ID = $1;
+	my $pairs = $3;
+	while ($pairs =~ s/\|(\d+),(\d+)//) { #this is the list of keyphrases and numbers
+	    my $phrase_index = $1;
+	    my $num_phrase = $2;
+	    $document{"$phrase_index"} = "$num_phrase"; #table to be stored in another table
+	}
+	$document_phrases{"$ID"} = ({%document});	  
+	$N++; #number of documents in the collection (which have kea metadata)
+    }
+}
+
+close(DOC_FILE);
+ 
+#we do not want to recalculate measures ie if we have already calculated
+#doc1 & doc2 we do not then want to calculate doc2 & doc1
+#to achieve this we must first sort the list of ids so that both lists
+#of documents will be in the same order (otherwise hash tables return values in 
+#no particular order). We then compare each document in the left 
+#column below against the documents in the right column:
+
+#doc0 -> 
+#doc1 -> doc0 
+#doc2 -> doc0, doc 1 
+#doc3 -> doc0, doc 1, doc 2 
+#doc4 -> doc0, doc 1, doc 2, doc 3 
+#doc5 -> doc0, doc 1, doc 2, doc 3, doc 4 
+#etc
+
+#this way we are not recalculating the same value and also not
+#comparing each document to itself (which would result in the
+#value 1) thus more than halving the processing time.
+
+print STDERR "\ncalculating cosine measures for $N documents...\n";
+
+$count = 0;
+@ids = sort keys(%document_phrases);
+
+#repeat for all pairs of documents
+foreach $id1 (sort keys(%document_phrases)) { 
+    my %table;
+   
+    for($i=0; $i<$count; $i++){ #calculate the cosine measure and store
+	my $cosine_measure = &compare_docs($id1, $ids[$i]); 
+	$table{"$ids[$i]"} = "$cosine_measure";  	
+    }
+    $cosine_matrix{"$id1"} = ({%table});
+    $count++; #each iteration the number of documents to compare against expands by 1
+}
+
+&addtogml(); #add the relational data we have just gathered to the documents gml files
+
+   
+#this function takes as an argument two document IDs and uses these to extract the
+#keyphrases from the document_keyphrase data structure.  It then calculates a 
+#'measure of relativity' [0-1] with which we can establish how similar the two
+#documents are to each other. (0-not related, 1-same document).  The equation 
+#used to establish this similarity:
+#
+#                     for all phrases 
+#                     in both d1, d2 (fd1p * loge(N/fp) (fd2p * loge(N/fp) 
+#  cosine(d1, d2) = --------------------------------------------------------------
+#                     sqrt(sum of phrases in d1(fd1p * loge(N/fp))) * 
+#                     sqrt(sum of phrases in d2(fd2p * loge(N/fp))) 
+#
+#where d1 and d2 are lists of keyphrase and represent documents
+#fd1p is the frequency that phrase p occurs in document d1
+#fd2p is the frequency that phrase p occurs in document d2
+#fp is the number of documents that have p as a keyphrase
+#N is the number of documents in the collection 
+sub compare_docs {
+
+  
+    my $ID1 = shift(@_); #ID for document one 
+    my $ID2 = shift(@_); #ID for document two
+  
+    my @phrases; #a list of phrases in document 1 and document 2
+    my @phrases1; #a list of phrases in document 1
+    my @phrases2; #a list of phrases in document 2
+    
+    
+    foreach $phrase (keys %{ $document_phrases{$ID1}}) { #list of phrases in doc1
+	push(@phrases1, $phrase);
+    } 
+    foreach $phrase (keys %{ $document_phrases{$ID2}}) { #list of phrases in doc2
+	push(@phrases2, $phrase);
+    }
+    foreach $phrase1 (@phrases1) { #list holds intersection of doc1 and doc2
+	foreach $phrase2 (@phrases2) {
+	    push(@phrases, $phrase1) if ($phrase1 == $phrase2);
+	}
+    }
+ 
+#COSINE MEASURE
+    my $wqtwdt= 0; 
+   
+    foreach $phrase (@phrases){ #for all phrases ocurring in d1 and d2
+	#the frequency that phrase occurs in document d1
+	$fd1p = $document_phrases{$ID1}{$phrase}; 
+	
+	#log base e(N/the number of documents that have phrase as a keyphrase)
+	$log_freq = log($N/$phrases_document{$phrase});
+	
+	#the frequency that phrase occurs in document d2
+	$fd2p = $document_phrases{$ID2}{$phrase};
+	$sum = ($fd1p * $log_freq) * ($fd2p * $log_freq);
+	$wqtwdt += $sum;
+    }
+  
+   
+    my $wd = 0; #stores the calculation for wd
+
+    foreach $phrase (@phrases1){ #for all phrases ocurring in d1 and d2
+	#the frequency that phrase occurs in document d1
+	$fd1p = $document_phrases{$ID1}{$phrase};
+	
+	#log base e($N/the number of documents that have phrase as a keyphrase)
+	$log_freq = log($N/$phrases_document{$phrase});
+	$sum = $fd1p * $log_freq;
+	$wd += ($sum * $sum); #sum squared
+    }
+
+   
+    my $wq = 0; #stores the calculation for wq
+ 
+    foreach $phrase (@phrases2){ #for all phrases ocurring in d2
+	#the frequency that phrase occurs in document d2
+	$fd2p = $document_phrases{$ID2}{$phrase};
+
+	#log base e($N/the number of documents that have phrase as a keyphrase)
+	$log_freq = log($N/$phrases_document{$phrase});
+	$sum = $fd2p * $log_freq;
+	$wq += ($sum * $sum); #sum squared 
+    }
+   
+    my $wdwq = sqrt($wq)  * sqrt($wd);  
+    my $cosine = $wqtwdt / $wdwq;
+    
+    return $cosine;
+	
+}
+   
+#this function adds the relational data we have collected to the gml files
+sub addtogml {
+
+ print STDERR "\nadding relational data to $N gml documents...\n\n";
+ my @doclist;
+ my %filetable;
+ my $pattern = "kea="; #pattern to search for to find where to insert relation data
+
+ #open archive info for each collecticollection
+ foreach $collection (@directories){
+
+     open(INFO, "$gsdlhome/collect/$collection/archives/archives.inf") 
+	 or die "$gsdlhome/collect/$collection/archives/archives.inf could not be opened";
+     
+     #read a list of ID's and pathnames into a file table
+     while(<INFO>){
+	 chomp;
+	 my %idtable;
+	 my $ID;
+	 if(/(\w+)(\s+)([\w\.\/]+)/){ #format of the line
+	     $ID = $1;
+	     $path = $3;
+	     $idtable{"$path"} = "$collection";
+	 }
+	 $filetable{"$ID"} = ({%idtable});
+     } 
+  
+     close(INFO);
+ }
+
+ 
+
+ #for each id in the matrix calculate a list of related documents
+ foreach $id (keys %cosine_matrix){    
+    
+     @doclist = &calculate_list($id); #gets list of documents with most relevant scores
+
+     my @path = keys %{$filetable{$id}}; #get filepath for document
+     my $collection = $filetable{$id}{$path[0]};
+     
+     #open gml file to amend for each collection
+     open(FILE, "$gsdlhome/collect/$collection/archives/$path[0]") 
+	 or die "$gsdlhome/collect/$collection/archives/$path[0] could not be opened";
+     
+     #read the gml file into text
+     $text = ""; 
+     while(<FILE>){
+	 $text .= $_;
+     }
+     
+     close(FILE);
+     
+     #delete previous relational data and urllinks to files storing rel doc links
+     $text =~ s/(\s)+relation=\"([^\"]*)\"//g;
+     $text =~ s/(\s)+urllink=\"([^\"]*)\"//g;
+     $text =~ s/(\s)+\/urllink=\"([^\"]*)\"//g;
+     
+     #if we want to insert each relation item as 'relation1="id" relation2="id"'
+     #$count = 1; #insert each item in the list
+     #foreach $item (@doclist){ #insert list into text
+     #	 $text =~ s/(\s)($pattern)/ relation$count=\"$item\" $2/g;
+     #	 $count++;
+     #} 
+     
+     #or relation="id, id, id"
+     #my $relation = join(",", @doclist);
+
+     #if pdf flag is set then delete pdf url document
+     if($do_pdfs == 1){ 
+	 my $dirpath = $path[0];
+	 $dirpath =~ s/(^(\/doc\.gml))*\/doc\.(gml)/$1/;
+ 	 `rm $gsdlhome/collect/$collection/index/assoc/$dirpath/url.txt`; 
+     }
+
+     my $title = "related document";
+     $title = $2 if($text =~ /(\s)+Title=\"([^\"]*)\"/g);
+   
+     #relation="collection,id collection,id"
+     my @relationlist;
+     my $relation = "";
+     foreach $doc (@doclist){
+	 my @p = keys %{$filetable{$doc}};
+	 my $collect = $filetable{$doc}{$p[0]};
+	 push(@relationlist, "$collect,$doc");
+
+	 #write pdf docs to file
+	 if($do_pdfs == 1){
+	     my @rel_path = keys %{$filetable{$doc}};
+	     &write_related_urls($title, $collection, $path[0], $collect, $rel_path[0]);
+	 }
+     }
+  
+     #modify the text to include relation data
+     $relation = join(" ", @relationlist); 
+     $text =~ s/($pattern)/ relation=\"$relation\" $1/g;
+
+     #open gml file to write back new text
+     open(FILE, ">$gsdlhome/collect/$collection/archives/$path[0]") or print STDERR "NO!!!!\n";
+     print FILE "$text"; #write back text
+     close(FILE);
+
+     #amend the pdf file 
+     if($do_pdfs == 1){
+	 my $pdf_path = $path[0];
+	 $pdf_path =~ s/(^(\/doc\.gml))*\/doc\.(gml)/$1/;
+	 `perl amend_pdf.pl $gsdlhome/collect/$collection/index/assoc/$pdf_path/doc.pdf $gsdlhome/collect/$collection/index/assoc/$pdf_path/url.txt\n`;
+     }
+ } 
+}
+
+#this function builds a list of cosine measures for each
+#document and sorts the list of ids each measure belongs to
+#in reverse order (ie docs with greatest cosine measure first)
+#returns the list calculated
+sub calculate_list {
+   
+    my $document = shift(@_);
+    my %measures;
+    my @doclist;
+    
+    
+    #find the top $number_of_files for $document  
+    foreach $id (keys %{$cosine_matrix{$document}}){ 
+	    $measures{"$cosine_matrix{$document}{$id}"} = "$id";
+    }
+    
+    my @list = reverse sort {$a<=>$b} keys %measures;
+
+    #list is as big as specified in command line (default is 1)
+    for($i = 0; $i<$number_of_files; $i++){ 
+	my $id = $measures{$list[$i]};
+	push(@doclist, $id) if($id ne "");
+    }
+
+    return @doclist;
+}
+
+
+sub write_related_urls {
+
+    
+ #need server name eg nzdl2.cs.waikato.ac.nz
+ #localhost should work but doesn't on this computer?
+ #open up config file to read httpprefix
+ #get collection name of related document
+ #get hash directory of related document
+ #write http://nzdl2.cs.waikato.ac.nz/httpprefix/collectionname/index/assoc/directory/doc.pdf
+
+ my ($title, $collection, $path, $collect, $rel_path) = @_;
+
+ $rel_path =~ s/(^(\/doc\.gml))*\/doc\.(gml)/$1/;
+ $path =~ s/(^(\/doc\.gml))*\/doc\.(gml)/$1/;
+ 
+ print STDERR "writing related pdf urls to file ";
+ print STDERR "$gsdlhome/collect/$collection/index/assoc/$path/url.txt...\n";
+ 
+ open(URL, ">>$gsdlhome/collect/$collection/index/assoc/$path/url.txt") 
+     or open(URL, ">$gsdlhome/collect/$collection/index/assoc/$path/url.txt")
+	 or print STDERR "This file $title is not a pdf file\n";
+
+ print URL "$title\t"; 
+ print URL "http://$servername/$httpprefix/collect/$collect/index/assoc/$rel_path/doc.pdf\n";
+ close URL;
+
+}
+
+
+
+
+
+
+
