# FILE: fcn-html.pl
# DESCRIPTION: HTML to formatting tags converstion; auto-activations
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### activate_links
###
### Converts URLs and e-mail addresses to links
###

sub activate_links {
	my ($text, $FORMref, $noactivate_tags) = @_;
	return $text if $FORMref->{active_links} == 0 && $FORMref->{active_links_a};
	return $text if ! $FORMref->{active_links_a} && $text =~ /\\\S+\{.+\}/s;
	my $default_open_tag = ('topurl', 'newurl', 'link')[0+$GLOBAL_OPTIONS->{default_autoactivate_frameset}];
	if (! defined $PARAMS->{webtags_no_active}) {
		my $wtc = defined $PARAMS->{webtags_conf} ? $PARAMS->{webtags_conf} : readfile("$DCONF->{admin_dir}/webtags.conf", "read_tags", { no_lock => 1, no_unlock => 1 });
		$PARAMS->{webtags_conf} = $wtc;
		foreach $_ (@{$wtc}) {
			next if /^#/ || ! /\S/;
			$_ = trim($_);
			if (my ($evaltag, $cont, $code, $act) = m|^(\*?)([cC0-9sSmM]\*?)\s*(\S+)\s*(.*)|) {
				$code = char_convert(lc($code));
				if ($cont =~ /\*$/) {
					$PARAMS->{webtags_no_active}->{$code} = 1;
				}
			}
		}
		$PARAMS->{webtags_no_active}->{form} = 1;
	}
	my $noactive_tags = "imagelink|topurl|link|newurl|mail|";
	$noactive_tags .= join("|", keys %{$PARAMS->{webtags_no_active}}) if ref $PARAMS->{webtags_no_active} eq 'HASH';
	$noactive_tags =~ s/\|$//;
	my @u = split(/\\(?:$noactive_tags)\{.*?\}/io, $text);
	my @v = (); while ($text =~ /\\($noactive_tags)\{.*?\}/gio) { push @v, $&; };

# 	New code to prevent interference with tags that take URLs:
#	my @u = split (/\\\S+\{(?:[^\s\}\\]|\\,)+,/o, $text);
#	my @v = (); while ($text =~ /(\\\S+\{(?:[^\s\}\\]|\\,)+,)/og) { push @v, $1; }
	
	foreach my $u (@u) {
		my $after = $u; my $m = "";
W1:		while ($after =~ m%(https?://|www\.)([\w\-\.\+/~\%\?\&\=\:\,\#\^]+)%i) {
			$after = $'; my ($before, $one, $two) = ($`, $1, $2);
			if ($two !~ /^([\w\-]+)\.([\w\-]+)/) {
				$m .= join("", $before, $one, $two);
				next W1;
			}			
			my $url = join("", $one, $two);
			$one = join("", "http://", $one) if $one !~ /^https?:/i;
			my $url_link = join("", $one, $two);
			if ($url =~ m|([\.\:\;\,])$|) {
				$url = $`; $after = "$1$after";
			}
			$url_link = $` if $url_link =~ m|([\.\:\;\,])$|;
			$url_link =~ s/,(.)/\%2C$1/g;
			$m .= join("", $before, "\\$default_open_tag\{$url_link,$url}");
		}
		$u = join("", $m, $after);
		$after = $u; $m = "";
W2:		while ($after =~ m%(ftp?://|ftp\.)([\w\-\.\+/~\%\?\&\=\:\,]+)%i) {
			$after = $'; my ($before, $one, $two) = ($`, $1, $2);
			if ($two !~ /^([\w\-]+)\.([\w\-]+)/) {
				$m .= join("", $before, $one, $two);
				next W2;
			}			
			my $url = join("", $one, $two);
			$one = join("", "ftp://", $one) if $one !~ /^ftp:/i;
			my $url_link = join("", $one, $two);
			if ($url =~ m|([\.\:\;\,])$|) {
				$url = $`; $after = "$1$after";
			}
			$url_link = $` if $url_link =~ m|([\.\:\;\,])$|;
			$url_link =~ s/,(.)/\%2C$1/g;
			$m .= join("", $before, "\\$default_open_tag\{$url_link,$url}");
		}
		$u = join("", $m, $after);
		$after = $u; $m = "";
W3:		while ($after =~ m|([\w\-\+\.]+)\@([\w\-\+\.]+)|i) {
			$after = $';
			my ($url, $before) = (join("", $1, "\@", $2), $`);
			if ($url =~ m|([\.\:\;\,])$|) {
				$url = $`; $after = "$1$after";
			}
			my $url_link = $url;
			$url_link = $` if $url_link =~ m|([\.\:\;\,])$|;
			$url_link =~ s/,(.)/\%2C$1/g;
			$m .= join("", $before, "\\mail\{$url_link,$url}");
		}
		$u = join("", $m, $after);
		$after = $u; $m = "";
	}
	foreach my $v (@v) {
		if ($v =~ /^\\(\w+)\{(.*?),(.*)\}/) {
			my ($tag, $url, $aft) = ($1, $2, $3);
			if ($url =~ /^([\w\-]+)\.([\w\-]+)\.([\w\-]+)/) {
				$url = join("", "http://", $url);
			}
			$v = join("", "\\", $tag, '{', $url, ",", $aft, "}");
		}
	}	
	my $message = "";
	while (scalar(@u) + scalar(@v)) {
		$message .= shift @u; $message .= shift @v;
	}
	return $message;	
}

###
### html_to_webtags
###
### Converts incoming unvalidated user HTML into Discus formatting tags
###

sub html_to_webtags {
	my ($text, $FORMref) = @_;
	return $text if $FORMref->{html} == 0 && $FORMref->{html_a};
	return $text if ! $FORMref->{html_a} && $text =~ /\\\S+\{.+\}/s;
	my $u = readfile("$DCONF->{admin_dir}/htmlconvert.conf", "html_to_webtags", { no_lock => 1, no_unlock => 1});
	my @X = grep(/\S/, grep(!/^\s*#/, @{ $u }));
	my @j = (); my $defs = {};
	study $text;
	foreach my $line (@X) {
		my ($cmd, $tag, $start, $end) = split_html_webtags_line($line);
		if ($cmd =~ /o/i) {
			$defs->{$start} = $end;
		} else {
			next if $text !~ /$start/i;
			next if $text !~ /$end/i;
			$tag =~ s/\[\\n\]/\n/g;
			push @j, { start => $start, end => $end, tag => $tag };			
		}		
	}	
	my @u = split(/<.*?>/, $text);
	my @v = (); while ($text =~ /(<.*?>)/g) { push @v, reorder_tag_arguments($1, $defs); }
	$text = "";
	while (scalar(@u) + scalar(@v)) {
		$text .= shift @u; $text .= shift @v;
	}
	foreach my $j (@j) {
		if ($text =~ /$j->{start}/) {
			while (my @r = $text =~ /(.*)$j->{start}(.*?)$j->{end}/is) {
				my $after = $'; my $before = $`;
				my $one = shift @r;
				my @a = splice @r, 0, scalar(@r)-1;
				my $txt = shift @r;
				my $ttg = $j->{tag};
				$ttg =~ s/\$(\d+)/$a[$1-1]/ge;
				$ttg =~ s/\$\'/$txt/g;
				$text = join("", $before, $one, $ttg, $after);
			}
		}
	}
	return $text;
}

###
### give_base_tag
###
### Determines which tag is being passed
###

sub give_base_tag {
	my ($text) = @_;	
	if ($text =~ /<\s*([^\s>]+)/) {
		my $o = case_lower($1);
		return $o;
	}
	return undef;	
}

###
### reorder_tag_arguments
###
### Reorders arguments within a tag, deletes superfluous arguments
###

sub reorder_tag_arguments {
	my ($usertag, $defs) = @_;
	my $bt = case_lower(give_base_tag($usertag));
	return join($bt, "<", ">") if ! defined $bt || ! defined $defs->{$bt};
	my $u = {};
	while ($usertag =~ /\s(\w+)\s*=\s*['"]?(.*?)['"\s>]/g) {
		my $o = case_lower($1);
		my $z = $2;
		$u->{$o} = $z;
	}	
	my @j = split(/,/, $defs->{$bt});
	my @t = ();
	foreach my $j (@j) {
		push @t, join("", $j, "=", '"', $u->{$j}, '"') if defined $u->{$j};
	}
	my $jt = join(" ", @t);
	my $text = join("", "<", $bt, " ", $jt, ">");
	return $text;		
}

###
### split_html_webtags_line
###
### Splits a line from the HTML to webtags configuration file
###

sub split_html_webtags_line {
	my ($line) = @_;
	$line =~ s/\s+$//;
	my ($command, $tag, $rest) = split(/\s+/, $line, 3);
	my @r = split(/\s+/, $rest);
	my $ending = pop @r;
	return ($command, $tag, join(" ", @r), $ending);	
}


###
### find_within_array
###
### Finds the position of the first matching element of an array
###

sub find_within_array {
	my ($pattern, $array) = @_;
	my $counter = 0;
	foreach my $element (@{ $array }) {
		return $counter if $element =~ /$pattern/i;
		$counter++;
	}
	return undef;
}


1;
