HTML::ForumCode - BBCode-esque forum markup

  use HTML::ForumCode;

  my $tt_forum  = HTML::ForumCode->new();
  my $formatted = $tt_forum->forumcode($text);

  # load the TT module
  [% USE ForumCode %]

  # ForumCodify some text
  [% ForumCode.forumcode('[b]bold[/u] [u]underlined[/u] [i]italic[/i]') %]
  [% ForumCode.forumcode('**bold** __underlined__') %]

package HTML::ForumCode;
# vim: ts=8 sts=4 et sw=4 sr sta
use strict;
use warnings;

use version; our $VERSION = qv('0.0.5')->numify;

use Template::Plugin::HTML;

sub new {
    my ($class, @args) = @_;

    my $new_obj = bless {}, (ref($class)||$class);
    $new_obj->init;

    return $new_obj;
}

sub init {
    my $self = shift;

    # simple [x][/x] --> <x></x> tags
    $self->{simple_tags} = [qw{
        b
        u
        i
    }];
    # replacements; e.g. __x__ --> <u>x</u>
    $self->{replacements} = [
        {   from => '__',       to => 'u'   },
        {   from => '\*\*',     to => 'b'   },
    ];

    return;
}

sub forumcode {
    my ($self, $text) = @_;

    # if we don't have any text, we don't have to do any work
    if (not defined $text) {
        return q{};
    }

    # first of all ESCAPE EVERYTHING!
    $text = Template::Plugin::HTML->escape($text);

    # turn newlines into <br /> tags
    $self->_preserve_newlines(\$text );

    $self->_simple_tags     ( \$text );
    $self->_replacements    ( \$text );
    $self->_colouring       ( \$text );
    $self->_lists           ( \$text );
    $self->_url_links       ( \$text );
    $self->_images          ( \$text );
    $self->_styled_block    ( \$text );
    $self->_quoted_block    ( \$text );
    
    return $text;
}

sub _preserve_newlines {
    my ($self, $textref) = @_;

    $$textref =~ s{\n}{<br />}xmsg;
}

sub _simple_tags {
    my ($self, $textref) = @_;

    # deal with acceptable [x]...[/x] markup
    foreach my $tag (@{ $self->{simple_tags} }) {
        # we should be able to combine these two into one
        #$$textref =~ s{\[$tag\]}{<$tag>}g;
        #$$textref =~ s{\[/$tag\]}{</$tag>}g;
        $$textref =~ s{
                        \[($tag)\]
                        (.+?)
                        \[/$tag\]
                }
                {<$1>$2</$1>}xmsg;
    }
}

sub _replacements {
    my ($self, $textref) = @_;

    # now deal with replacements
    foreach my $tag (@{ $self->{replacements} }) {
        $$textref =~ s{
                        $tag->{from}
                        (.+?)
                        $tag->{from}
                }
                {<$tag->{to}>$1</$tag->{to}>}gx;
    }
}

sub _url_links {
    my ($self, $textref) = @_;

    # deal with links with no text-label
    $$textref =~ s{\[url\](.+?)\[/url\]}
                {<a href="$1">$1</a>}xmsg;
    # deal with links with a text-label
    $$textref =~ s{
                \[url           # start of url tag
                \s+             # need some whitespace
                name=&quot;     # name="
                (.+?)           # the name
                &quot;          # closing "
                \s*             # optional whitespace
                \]              # close the opening tag
                (.+?)           # the url
                \[/url\]        # close the URL tag
        }
        {<a href="$2">$1</a>}xmsg;
    # bbcode / explosm style urls
    $$textref =~ s{
                \[URL=&quot;    # opening url tag
                (.+?)           # the url
                &quot;\]        # close-opening tag
                (.+?)           # link name/text/label
                \[/URL]         # closing tag
        }
        {<a href="$1">$2</a>}ximsg;
}

sub _images {
    my ($self, $textref) = @_;

    # deal with image tags
    $$textref =~ s{
                \[img           # opening img tag
                (.*?)           # optional parameters
                \]              # close-opening tag
                (.+?)           # image URL
                \[/img\]        # closing img tag
        }
        #{<img src="$2"$1 />}ximsg;
        {&_image_tag_with_attr($2,$1)}ximsge;
}

sub _image_tag_with_attr {
    my ($uri, $attr_match) = @_;

    # no annoying image attributes to worry about
    if (q{} eq $attr_match) {
        return qq{<img src="$uri" />};
    }
    # deal with annoying image attributes
    else {
        $attr_match =~ s{
                        (\w+)
                        =
                        &quot;
                        (\w+?)
                        &quot;
                }
                {$1="$2"}xmsg;
        return qq{<img src="$uri"$attr_match />};
    }
}

sub _colouring {
    my ($self, $textref) = @_;

    # deal with colouring
    $$textref =~ s{
                \[(colou?r)
                =
                (
                            red | orange | yellow | green | blue
                        | black | white
                        | \#[0-9a-fA-F]{3}
                        | \#[0-9a-fA-F]{6}
                )
                \]
                (.+?)
                \[/\1\]
        }
        {<span style="color: $2">$3</span>}ixmsg;
}

sub _lists {
    my ($self, $textref) = @_;

    $$textref =~ s{
                \[list\]
                (?:
                        \s*
                        (?:
                                <br\s*?/>
                        )?
                        \s*
                )
                (.+?)
                \[/list\]
                [\s]*
                (?:
                        <br\s*?/>
                )?
        }
        {_list_elements($1)}xmsge;
}

sub _list_elements {
    my ($text) = @_;

    # ordered lists
    if (
        $text =~ s{
                        \[\*\]
                        \s*
                        (.+?)
                        <br\s*?/>
                        \s*
                }
                {<li>$1</li>}xmsg
    ) {
        return qq{<ul>$text</ul>};
    }

    # ordered lists
    if (
        $text =~ s{
                        \[1\]
                        \s*
                        (.+?)
                        <br\s*?/>
                        \s*
                }
                {<li>$1</li>}xmsg
    ) {
        return qq{<ol>$text</ol>};
    }


    # otherwise, just return what we were given
    return $text;
}

sub _styled_block {
    my ($self, $textref) = @_;

    $$textref =~ s{
                \[(code|pre|quote)\]
                (.+?)
                \[/\1\]
        }
        {<div class="forumcode_$1">$2</div>}xmsg;
}

# this deals with the extended case of [quote] where we have the quoting=
# attribute
sub _quoted_block {
    my ($self, $textref) = @_;

    $$textref =~ s{
                \[
                        (quote)
                        \s+
                        quoting=
                        &quot;
                        (.+?)
                        &quot;
                \]
                (.+?)
                \[/\1\]
        }
        {<div class="forumcode_$1"><div class="forumcode_quoting">Quoting $2:</div>$3</div>}xmsg;
}

1;
__END__
vim: ts=8 sts=4 et sw=4 sr sta