#!/usr/local/bin/perl5 -w
# Execute as activeref.pl ORGINAL PROCESSED MAPFILE
# ORGINAL is input file
# PROCESSED will hold processed file 
#
# Open needed files
use English;
#
#	Set Up MapFile
undef %maptourl;
if(defined($ARGV[2]))	{
	open(MAPTOURL,$ARGV[2] )  || die("\nSorry couldnt Open",$ARGV[2], "\n");
	while($line=<MAPTOURL> )	{
		chomp($line);
		next unless $line;
		if( $line =~ m%(^\S+)\s+(\S+)$%)	{
			$maptourl{$1} = $2;
		}
		else	{
			print "Illegal Mapping $line\n";
		}
	}
}
#
open(ORIGINAL,$ARGV[0]) || die("\nSorry couldnt Open",$ARGV[0], "\n");
open(PROCESSED,"+>".$ARGV[1]) || die("\nSorry couldnt Create",$ARGV[1], "\n");
#
while($line=<ORIGINAL>)	{
	chomp($line);
	next unless $line;
	$rest=$line;
	while($rest)	{
		if( ($rest =~ m%(http://|ftp://)([^\s]+)\s%) || ($rest =~ m%(http://|ftp://)([^\s]+)$%) )	{
			$begin = $PREMATCH;
			$beginout = &addmap($begin);
			print PROCESSED $beginout;
			$url = $1.$2;
			$end = '';
			$end = $POSTMATCH if($POSTMATCH);
			while($url)	{
				last if( ($url =~ m%html$%i) || ($url =~ m%htm$%i) || ($url =~ m%\.ps$%i) || ($url =~ m%gif$%i) || ($url =~ m%jpg$%i) );
				$url =~ m%.$%;
				$test = $MATCH;
				$rem = $PREMATCH;
				if( ($test eq ')') || ($test eq ']') || ($test eq '(')|| ($test eq '[')|| ($test eq ',')|| ($test eq ';') )	{
					$url = $rem;
					$end = $test . $end;
				}
				else	{
					last;
				}
			}
			print $url,"\n";
			if( ($begin =~ m%href\s*=\s*["|']$%i) || ($end =~ m%^\s*["|']\s*>%) || ($end =~ m%^\s*</a>%i) )	{
				print $url,' IGNORED in ',$line,"\n";
				print PROCESSED $url;
			}
			else	{
				print PROCESSED '<a href="' . $url . '" >' . $url . '</a>';
			}
			$rest = $end;
		}
		else	{
			$rest = &addmap($rest);
			print PROCESSED $rest;
			$rest = '';
		}
	}
	print PROCESSED "\n";
}
sub addmap	{
#
	my($text) = @_;
	foreach $item (keys(%maptourl))	{
		if( $text =~ m%$item% )	{
			print "Map item $item in $text\n";
			$text =~ s%$item%<a href=\"$maptourl{$item}\" >$item</a>%g;
		}
	}
	return $text;
}
#
#	Join  2 lines together returning result
#       add white space as necessary
sub join	{
	my($a,$b) = @_;
	$a = $a . ' '	if( ($a =~ /\S$/) && ($b =~ /^\S/) ) ;
	return $a . $b ;
}
