#!perl -w

use strict;

# this demos the extended link proposal by NPB
# created:	2000.11.22.n3
# updated:	2000.11.23.n4
# author:	Nathan Bronecke

# In many places in Everything-code, there is something like
# 	$text =~ s/\[(.*?)\]/ (linkNode or linkNodeTitle called) /egs;
# 	to create a link.
# 	Unfortuneatly, the extended link allows escaping characters, so creating a
# 	regex for this is a problem for me, and possibly others; this means that
# 	wherever extending linking is wanted, this:
# 	$text = superLink($text);
# 	should be used instead of the original RE.

#NPB TODO I would think it will be faster to use split on the entire string with a regex checking for []\|
#NPB TODO taint check, to make sure everything gets filtered

# there are a few places this would normally use the database for access checking,
# 	but for simplicity in testing, it has been replaced with ????????


# these are the special characters that denote links, that are constant for a given site
# once these are chosen, they'll probably never be changed
# note: these are not limited to a single character
my $linkOpen = '[';
my $extendLinkOpen = '|';	#if this immediately follows the link open text, it means that this is an extended link
my $linkClose = ']';





#this is more to spec than ebase/Everything/Util.pm/escape is
#Util.pm's escape only uses [^A-Za-z0-9_], plus this converts spaces into plus signs, which is a more human-readable
sub urlescape($) {
	my $result = $_[0];
#	$result =~ s/([^A-Za-z0-9.\-*_ ])/sprintf('%%%02X',ord($1))/ge;			#this way is common, but still converts some valid characters
	$result =~ s/([^A-Za-z0-9\-_.!~*'() ])/sprintf('%%%02X',ord($1))/ge;	#unreserved characters: RFC 2396, section 2.3
	$result =~ s/ /+/g;
	return $result;
}






#ignore this, just borrowed from ebase/Everything/HTML.pm
sub encodeHTML($) {
	my $html = $_[0];
	$html =~ s/\&/\&amp\;/g;
	$html =~ s/\</\&lt\;/g;
	$html =~ s/\>/\&gt\;/g;
	$html =~ s/\"/\&quot\;/g;
	return $html;
}







#parameter
#	$thingToEnd - the entire string after the extended link indicator
#return
#	list of length 2
#		0 - the number of characters this link consumed
#		1 - the HTML for the link
sub parseExtendedLink($) {
	my $thingToEnd = $_[0];
	my $len = length($thingToEnd);

	my $i;
	my $c;	#single character
	my $site;	#the site we're linking to
	my $s = '';	#current thing working on
	my @params = ();	#the key/value pairs of parameters (not using hash b/c order may be important)

	#first, figure out the extended stuff
	$i=-1;
	while(++$i<$len) {
		$c=substr($thingToEnd,$i,1);	#get current character

		if($c eq "\\") {
			#take next character verbatim
			$s .= substring($thingToEnd,++$i,1);

		} elsif($c eq '|') {
			#starting the link's link-to value
			++$i;
			my $numParams = scalar @params;
			if($numParams == 0) {
				if(length($s)!=0) {
					#no parameters at all, so set the key part
					push @params, [($s,'')];
				}
			} elsif(length($params[$numParams-1][1])==0) {
				#don't have the value part set, so set it now
				$params[$numParams-1][1]=$s;
			} else {
				#key with no value
				push @params, [($s,'')];
			}
			last;

		} elsif(($c eq ':') && (!defined($site))) {
			$site = $s;
			$s = '';

		} elsif($c eq '=') {
			if(!defined($site)) { $site = ''; }
			if(length($s)!=0) {
				push @params, [($s,'')];
				$s='';
			}

		} elsif($c eq '&') {
			if(!defined($site)) { $site = ''; }
			$params[(scalar @params)-1][1] = $s;
			$s='';

		} else {
			#normal character, so add it
			$s .= $c;
		}

	}
	if($i>=$len) {
		#improperly closed link
		return ($i,'');
	}
	if(!defined($site)) { $site = ''; }

	#determine what linking to, and what to display
	$s='';
	my $linkTo;
	my $linkShow;
	while($i<$len) {
		$c=substr($thingToEnd,$i++,1);
		if($c eq "\\") {
			$s .= substr($thingToEnd,$i++,1);
		} elsif (($c eq '|') || ($c eq ']')) {
			if(!defined($linkTo)) {
				$linkTo = $s;
			} elsif(!defined($linkShow)) {
				$linkShow = $s;
			} # else {
				#even more extended stuff that hasn't been defined yet; for now, just eat it and ignore it
			# }
			$s = '';
			last if $c eq ']';
		} else {
			#normal character, so add it
			$s .= $c;
		}
	}
	if(($i>$len) || !defined($linkTo)) {
		#improperly closed link or not linking to anything
		return ($i,'');
	}

	#clean up the links and make them safe
	$linkTo =~ s/\s+/ /;	#multiple white spaces are pointless, so just merge them
	if(!defined($linkShow)) { $linkShow = $linkTo; }
	$linkShow =~ s/\s+/ /;	#multiple white spaces are pointless, so just merge them
	$linkTo = urlescape($linkTo);
	$c=scalar @params;
	while($c-->0) {
		$params[$c] = [(urlescape($params[$c][0]),urlescape($params[$c][1]))];
	}
	#note: if the HTML-screening function has not been called yet, it should be called now on $linkShow

	#use database here:
	#check to make sure $site is linkable to (it must be in the DB and be a valid one for the user-author)
	#if not linkable to OR linking to current site (that should be a site-global setting - which site in the site table is the one we're on)
	my $url;
	#if valid site given, set $url to value of url_root in table 'site'
	$url = '';		#invalid site OR link to same site
	#append value of url_query in table 'site' to $url
	$url .=
		"index.pl?"		#demo, this should be removed and replaced with DB query (????????)
	;

	#use database here:
	#for given site, load up valid keys, and only allow legal parameters
	#as an example, this only allows 'type', 'node_id', 'node' keys (note: some things, like 'op' should NEVER be allowed, since they're so powerful)
	#the part of this that appends to $url is kind of what ebase/Everything/HTML.pm/urlGen does
	#????????
	{
		my @allowed = qw(type node_id node);
		my %allowed;
		foreach(@allowed) {
			$allowed{$_} = undef;
		}
		my $l=0;
		while($l<scalar(@params)) {
			if(exists($allowed{$params[$l][0]})) {
				$url .= $params[$l][0].'='.$params[$l][1].'&';
			}
			++$l;
		}
		if(length($linkTo)==0) { chop $url; }
	}

	#NPB TODO check other stuff (sites ????????)
	#NPB TODO return something

	if(length($linkShow)==0) { $linkShow = $url; }
	if(length($linkTo)!=0) { $url .= 'node='.$linkTo; }
	return ($i,'<a href="' . $url . '">' . $linkShow . '</a>');
#	return ($i, '[' . $site . '://' . $linkShow . ($linkShow eq $linkTo ? '' : '|' . $linkTo) . ']');
}












#ignore this; this is just borrowed from ebase/Everything/HTML.pm
sub linkNodeTitle {
	my ($nodename, $lastnode, $title) = @_;
	($nodename, $title) = split /\|/, $nodename;
	$title ||= $nodename;
	$nodename =~ s/\s+/ /gs;
	my $str = "";
	my $urlnode = urlescape($nodename);
	$str .= "<a href=\"index.pl?node=$urlnode";
	if ($lastnode) { $str .= "&lastnode_id=" . $lastnode;}
	$str .= "\">$title</a>";
	$str;
}











#parameters
#	$entire - the entire string to look for links in
#	$lastnode - id of the node currently on (used for building links) (only useful if linking on the same site)
sub superLink($;$) {
	my ($entire, $linknode) = @_;

	my $strOut = '';
	my $i;
	my $oldi = 0;
	my @result;

	while( ($i=index($entire,$linkOpen,$oldi)) != -1 ) {

		#note: this assumes the HTML is screened previously...
		#if it isn't pre-screened, call the screening function here, and below, and in parseExtendedLink
		$strOut .= substr($entire,$oldi,$i-$oldi);

		$i+=length($linkOpen);
		if(substr($entire,$i,length($extendLinkOpen)) eq $extendLinkOpen) {
			#extended link
			$i+=length($extendLinkOpen);
			@result = parseExtendedLink(substr($entire,$i));
			$oldi = $i+$result[0];
			$strOut .= $result[1];
		} else {
			#normal link
			$oldi=index($entire,$linkClose,$i);
			if($oldi==-1) { $oldi=length($entire)-1; }
			$strOut .= linkNodeTitle(substr($entire, $i, $oldi-$i), $linknode);
			++$oldi;
		}
	}

	#note: this assumes the HTML is screened previously...
	#if it isn't pre-screened, call the screening function here, and above, and in parseExtendedLink
	$strOut .= substr($entire,$oldi);

	return $strOut;
}









my $lineByLine = 0;		#set to 1 for interactive testing
my $entireThing='';
while(<>) {
	next if /^#/;	#just so easy way of not testing certain lines
	if($lineByLine) {
		chomp;
		print superLink($_),"\n";
	} else {
		$entireThing .= $_;
	}
}
if(!$lineByLine) {
	print superLink($entireThing);
}

exit;

