Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re: Looking for feed back on a guestbook

by orkysoft (Friar)
on Nov 16, 2001 at 02:45 UTC ( #125708=note: print w/ replies, xml ) Need Help??


in reply to Looking for feed back on a guestbook

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 &lt;font color=#1 +2aaFF&gt; - <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>};


Comment on Re: Looking for feed back on a guestbook
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://125708]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2014-10-31 08:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (215 votes), past polls