package HTML::BBCode;

use strict;
use warnings;

sub new {
        my $class = shift;
        my $self = {};
        bless($self, $class);
        $self->_init(@_);
        return $self;
}

sub _init {
        my $self = shift;
        my %attr = @_;
        my %tags = (
                b               => '<strong>%s</strong>',
                i               => '<span style="font-style:italic">%s</span>',
                u               => '<span style="text-decoration:underline">%s</span>',
                center  => '<div style="text-align:center">%s</div>',
                img             => '<img src="%s" alt="Bild" />',
                color           => '<span style="color:%s">%s</span>',
                size            => '<span style="font-size:%sem">%s</span>'
        );
        
        my %allowedTags = ();
        if (ref($attr{allowedTags}) eq 'ARRAY') {
                $allowedTags{$_} = $tags{$_} for @{$attr{allowedTags}};
        } else {
                %allowedTags = %tags;
        }
        $self->{escape_html} = 1 if $attr{escape_html};
        $self->{allowedTags} = \%allowedTags;
}

sub parse {
        my ($self, $text) = @_;
        $text = escape_html($text) if $self->{escape_html};
        $text =~ s/(?<![\n\r])\n(?![\r\n])/<br \/>/g;
        $text =~ s/[\n\r]+(.*)[\n\r]+/\n<p>$1<\/p>\n/g;
        for (keys %{$self->{allowedTags}}) {
                $text =~ s{
                        \[$_\](.+?)\[/$_\]
                } {
                        _replace($self,$_,$1)
                }egsx;
                $text =~ s{
                        \[($_)=([a-zA-Z_0-9\#]+)\](.+?)\[/$_\]
                } {
                        _replace($self,$1,$2,$3)
                }egsx;
        }
        return $text;
}

sub _replace {
        my $self = shift;
        return sprintf($self->{allowedTags}->{shift(@_)}, @_);
}

sub escape_html {
        my $text = shift;
        $text =~ s/&/&amp;/gso;
        $text =~ s/</&lt;/gso;
        $text =~ s/>/&gt;/gso;
        return $text;
}

1;

#!/usr/bin/perl

use strict;
use warnings;
use HTML::BBCode;

my $bbcode = HTML::BBCode->new(allowedTags => [qw(i size)], escape_html =>1);

my $string = "[size=3]Ha<test>llo[/size],\n[i]dies[/i]\n\nist ein\n\n[b]fetter Text[/b].[dd]test[/dd]\n";

print $bbcode->parse($string);

$bbcode->add_tags(font => '<span style="font-family:%s">%s</span>');

sub add_tags {
   my $self = shift;
   $self->{allowedTags}->{$_[0]} = {$_[1]};
}

sub syntax_hilight {
    my $text = shift;
    # mache hier das syntaxhilighting
    return $html_with_markup;
}
$bbcode->add_tag('perl', \&syntax_hilight);

sub frob_uri {
    my $url = shift;
    if ($url =~ m/evil_competitor/){
        return $url . '?ref_id=1234';
     }
     return $url;
}

$bbcode->add_callback_for('url', \&frob_uri);

$str = "Zeile 1\r\nZeile 2\r\nZeile3";

$str = "Zeile 1\nZeile 2\nZeile 3\n";

39:         $text =~ s/\r//g;
40:         $text =~ s/(?<![\n\r])\n(?![\r\n])/<br \/>/g;
41:         $text =~ s/[\n\r]+(.*)[\n\r]+/\n<p>$1<\/p>\n/g;