I still have this lying around, a subroutine to convert 'AAAtml' (in use at the boards at The Alien Adoption Agency (which is powered by Perl (though the db seems pretty flaky))). It's not 100% bug-free (it hiccups when you incorrectly write links), but otherwise, it's pretty good.
#!/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/countcl
+ick?";
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 ne
+sting error
} elsif($tag eq "/") { # Cl
+osing link tag
if($NESTED{link}) {
$NESTED{link} = 0;
my @i = ($link_description =~ /\w/g);
if(scalar @i) {
$link_description = processtext $link_descript
+ion;
} else { # No link desc
+ription
$link_description = processtext $link_location
+;
}
$html .= qq{ <a href="$link_prefix$link_location">
+$link_description</a> };
}
} else { # It must be a link lo
+cation 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 RG
+B
`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 ef
+fect.
$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 se
+cond 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; # Te
+xt
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_descri
+ption</a> };
}
return $html;
}
############
### MAIN ###
############
# This is a simple sample CGI program to demonstrate and debug the thi
+ng 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 co
+ls=40 rows=8>$atml</textarea><input type=submit></form>
<hr><h3>Explanation</h3><pre>
[http://location/]clickhere[/] - link (also [mailto:user\@host.tld]ema
+il me[/] )
[b][i][u] - they nest correctly, last past the end of line, and co-ope
+rate with colours
`0 .. `20 - predefined colours as in <a href="http://www.alienaa.com/h
+elp/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 <font color=#1
+2aaFF> - <b>Will not appear in the AAA for some reason</b>
`red; - descriptive color, as interpreted by your browser - <b>Can
+celled</b>
(this feature might get disabled, so don't count on it)
[text] - this is possible, but stray [ and ` characters will be ign
+ored 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>};
