#!/usr/bin/perl -wT
use strict;
use CGI;

# Convert AAAtml to safe and valid HTML
sub atml {
	sub processtext {
		my $text = shift;
		$text = CGI::escapeHTML($text);
		$text =~ s/\n/<br>/g;
		return $text;
	}
	my $atml = shift;
	my $html = "";

	my @colournames = qw(
		white green red blue orange yellow purple pink
		gray lightgrey lightblue yellowgreen turquoise
		steelblue plumb olive brown gold lawngreen tomato black
	);
	my %NESTED = (
		b => 0,			# Flag
		i => 0,			# Flag
		u => 0,			# Flag
		colour => 0,		# Flag
		list => 0,		# Flag
		link => 0,		# Flag
	);


	# Obviously, you'll need to change this $link_prefix:
	my $link_prefix = "http://this-is-just-something-i-made-up/countclick?";
	my $link_location = "";
	my $link_description = "";


	while($atml =~ m{
		(	\[.*?\]			|	# A tag
			``			|
			`\d\d?			|
			`\#[a-f\d]{6};?		|
			`br			|
			`li			|
			[^[`]+				# or a non-[-tag, non-`-tag string
		)					# Capture it!
			}gxi
	) {
		my $this_element = $1;
# print "<li>Element: $this_element</li>";
		if($this_element =~ m{^\[} ) {								# It's a tag
			my $tag = ($this_element =~ m{^\[(.*?)\]$})[0];
			$tag = lc $tag;
			if($tag =~ m{^(/?[biu])$}) {							# Starting or closing BIU tag
				my $biutag = $1;
				my $close = ($biutag =~ m{^/}) ? 1 : 0;					# Close or open tag?
				my $tagtype = substr $biutag, -1, 1;
				if($close == $NESTED{$tagtype}) {			# Is the tag open, and to be closed, or vice versa?
					$NESTED{$tagtype} = $close == 0 ? 1 : 0;			# Open / close tag
					$html .= "<$tag>";
				}									# Else, ignore nesting error
			} elsif($tag eq "/") {								# Closing link tag
				if($NESTED{link}) {
					$NESTED{link} = 0;
					my @i = ($link_description =~ /\w/g);
					if(scalar @i) {
						$link_description = processtext $link_description;
					} else {							# No link description
						$link_description = processtext $link_location;
					}
					$html .= qq{ <a href="$link_prefix$link_location">$link_description</a> };
				}
			} else {							# It must be a link location or text with a [
				if($tag =~ m{^(http://|mailto:)}) {					# Valid-looking link
					$link_location = $tag;
					$NESTED{link} = 1;
					$link_description = "";
				} else {
					if($NESTED{link}) {
						$link_description .= processtext $this_element;		# Link description
					} else {
						$this_element = processtext $this_element;		# Text
						if($NESTED{list} == 1) {				# Are we in a list?
							if($this_element =~ s!<br>!</li></ul>!) {	# Yep, end it at the end of line
								$NESTED{list} = 0;			# Now we're not in a list anymore
							}
						}
						$html .= $this_element;
					}
				}
			}
		} elsif($this_element =~ m{^			# Anchor at start of $this_element
				(	``		|	# `` - restore default colour
					`\d\d?		|	# `9 or `99 - set new colour no
					`\#[a-f\d]{6};?	|	# `#89abCD - new method to set colour
					`br		|	# REMOVED WORD COLOUR, but kept RGB
					`li
				)				# Capture it!
					}xi) {
			my $tag = $1;
			if($tag eq "`br") {
				$html .= "<br>";
			} elsif($tag eq "`li") {
				if($NESTED{list} == 1) {	# Are we in a list already?
					$html .= "</li></ul>";	# End it first
				}
				$NESTED{list} = 1;		# We're in a list,
				$html .= "<ul><li>";		# so start it
			} elsif($tag eq "``") {
				if($NESTED{colour} == 1) {
					$html .= "</font>";
				}
				$NESTED{colour} = 0;
			} elsif($tag =~ /^`(\d\d?)$/) {		# Tag is one or two digits
				my $colournr = $1;
				if($NESTED{colour} == 1) {	# Already a colour in effect.
					$html .= "</font>";	# Terminate it.
				} else {
					$NESTED{colour} = 1;
				}
				if($colournr < scalar @colournames) {	# Valid 1 or 2 digit code
					my $colour = $colournames[$colournr];
					$html .= qq{<font color="$colour">};
				} elsif(int($colournr / 10) < scalar @colournames) {	# First digit valid?
					my $colour = $colournames[int($colournr / 10)];	# Get colour for first digit (valid)
					my $digit  = $colournr % 10;			# Print second digit
					$html .= qq{<font color="$colour">$digit};
				}
			} elsif($tag =~ /^`#([a-f\d]{6});?$/i) {
				if($NESTED{colour} == 1) {
					$html .= "</font>";
				} else {
					$NESTED{colour} = 1;
				}
				$html .= qq{<font color="#$1">};
			}
		} else {								# It's a piece of text.
			if($NESTED{link}) {
				$link_description .= $this_element;			# Link description
			} else {
				$this_element = processtext $this_element;		# Text
				if($NESTED{list} == 1) {				# Are we in a list?
					if($this_element =~ s!<br>!</li></ul>!) {	# Yep, end it at the end of line
						$NESTED{list} = 0;			# Now we're not in a list anymore
					}
				}
				$html .= $this_element;
			}
		}
	}
	# Close all open tags. The above code should make sure no tags are nested, like <b><b>.
	$html .= "</font>"	if $NESTED{colour};
	$html .= "</li></ul>"	if $NESTED{list};
	$html .= "</b>"		if $NESTED{b};
	$html .= "</i>"		if $NESTED{i};
	$html .= "</u>"		if $NESTED{u};
	if($NESTED{link} == 1) {
		# This code is the same as the link generating code up there.
		# This is used to handly unterminated links
		$NESTED{link} = 0;
		my @i = ($link_description =~ /\w/g);
		if(scalar @i) {
			$link_description = processtext $link_description;
		} else {								# No link description
			$link_description = processtext $link_location;
		}
		$html .= qq{ <a href="$link_prefix$link_location">$link_description</a> };
	}
	return $html;
}


   ############
  ### MAIN ###
 ############

# This is a simple sample CGI program to demonstrate and debug the thing up there.


my $q = new CGI;
my $atml = $q->param('atml');

print qq{Content-type: text/html

<html><head><title>AAAtml parser</title></head><body>};

if($atml) {
	print "\n\n<table border=1 align=center><tr><th>Your text</th></tr><tr><td>\n\n";
	print atml $atml;
	print "\n\n</td></tr></table>";
}

print qq{<form method=get><h3>Enter AAAtml:</h3><textarea name=atml cols=40 rows=8>$atml</textarea><input type=submit></form>

<hr><h3>Explanation</h3><pre>
[http://location/]clickhere[/] - link (also [mailto:user\@host.tld]email me[/] )
[b][i][u] - they nest correctly, last past the end of line, and co-operate with colours
`0 .. `20 - predefined colours as in <a href="http://www.alienaa.com/help/colors.html">the AAA help files</a>
`br       - force new line, actually superfluous
`li       - bullet list item, lasts until your newline (not your `br)
`#12aaFF  - hexcolour, much like you can use in HTML &lt;font color=#12aaFF&gt; - <b>Will not appear in the AAA for some reason</b>
`red;     - descriptive color, as interpreted by your browser - <b>Cancelled</b>
(this feature might get disabled, so don't count on it)
[text]    - this is possible, but stray [ and ` characters will be ignored for now.

I'm hungry, so gimme <a href="mailto:mapster\@pop3free.com">feedback</a>!

(Because it is a GET form rather than a POST form, the maximum size
of the stuff you can enter is about 1k or so. This is not a bug.)

</pre></body></html>};