HTML::BBReverse - Perl module to convert HTML to BBCode and back

  use HTML::BBReverse

  my $bbr = HTML::BBReverse->new();

  # convert BBCode into HTML
  my $html = $bbr->parse($bbcode);
  # convert generated HTML back to BBCode
  my $bbcode = $bbr->reverse($html);

  my $bbr = HTML::BBReverse->new(
    allowed_tags => [
      qw( b i u code url size color img quote list email html )
    ],
    reverse_for_edit => 1,
    in_paragraph => 0,
    no_jslink => 1,
  );

  [list]some
  text or [b]bbcode[/b]
  here[*]item[/list]

  [list]
  [*]item[/list]

package HTML::BBReverse;

use strict;
use warnings;
use vars qw($VERSION);
$VERSION = "0.07";

sub new {
  my $self = shift;
  my $class = ref($self) || $self;
  my %args;
  $#_ % 2 ? %args = @_ : warn "Odd argument list at " . __PACKAGE__ . "::new";
  
  my %options = (
    allowed_tags => [ qw( b i u code url size color img quote list email html ) ],
    reverse_for_edit => 1,
    in_paragraph => 0,
    no_jslink => 1,
  );
  return bless { %options, %args}, $class;
}


sub parse {
  my $self = shift;
  local $_ = shift;

  (return '') if !$_;
  my %alwd; 
  foreach my $tag (@{$self->{allowed_tags}}) { $alwd{$tag} = 1 } 
  
  s/\&/\&amp\;/g;
  s/</\&lt\;/g;
  s/>/\&gt\;/g;
  s/\r?\n/<br \/>\n/g;
 # first convert the code, list and html-tags, which can't be parsed with a simple regular expression
  $_ = $self->_bb2html($_, $alwd{code}, $alwd{list}, $alwd{html}) if $alwd{code} || $alwd{list} || $alwd{html};
  if($alwd{b}) {
    s/\[b\]/<b>/ig;
    s/\[\/b\]/<\/b>/ig;
  } if($alwd{i}) {
    s/\[i\]/<i>/ig;
    s/\[\/i\]/<\/i>/ig;
  } if($alwd{u}) {
    s/\[u\]/<span style=\"text-decoration: underline\">/ig;
    s/\[\/u\]/<\/span><!--1-->/ig;
  } if($alwd{img}) {
    s/\[img\]([^"\[]+)\[\/img\]/"<img src=\"" . $self->_fix_jslink($1) . "\" alt=\"\" \/>"/eig; #"
    s/\[img=([^"\]]+)\]([^"\[]+)\[\/img\]/"<img src=\"" . $self->_fix_jslink($1) . "\" alt=\"$2\" title=\"$2\" \/>"/eig; #"
  } if($alwd{url}) {
    s/\[url=([^\]"]+)\]/"<a href=\"" . $self->_fix_jslink($1) . "\">"/ieg; 
    s/\[\/url\]/<\/a>/ig;
  } if($alwd{email}) {
    s/\[email\]([^"\[]+)\[\/email\]/<a href=\"mailto: $1\">$1<\/a>/ig; #"
  } if($alwd{size}) {
    s/\[size=([0-9]{1,2})\]/<span style=\"font-size: $1px\">/ig;
    s/\[\/size\]/<\/span><!--2-->/ig;
  } if($alwd{color}) {
    s/\[color=([^"\]\s]+)\]/<span style=\"color: $1\">/ig;  #"
    s/\[\/color\]/<\/span><!--3-->/ig;
  } if($alwd{quote}) {
    s/\[quote\]/<span class=\"bbcode_quote_header\">Quote: <span class=\"bbcode_quote_body\">/ig;
    s/\[quote=([^<\]]+)\]/<span class=\"bbcode_quote_header\">$1 wrote: <span class=\"bbcode_quote_body\">/ig;
    s/\[\/quote\]/<\/span><\/span>/ig;
  }
  s/\&#91\;/[/g;
  s/\&#93\;/]/g;
#  s/\r?\n$//;
#  s/\s$//;
  return $_;
}
sub _fix_jslink {
  my $self = shift;
  my $lnk = shift;
  $lnk =~ s/^[\s\t]*javascript://g if $self->{no_jslink};
  return $lnk;
}

sub reverse {
  my $self = shift;
  local $_ = shift;

  (return '') if !$_;
  my %alwd;
  foreach my $tag (@{$self->{allowed_tags}}) { $alwd{$tag} = 1 } 

  $_ = $self->_html2bb($_, $alwd{code}, $alwd{list}, $alwd{html}) if $alwd{code} || $alwd{list} || $alwd{html};
  if($alwd{b}) {
    s/<b>/[b]/g;
    s/<\/b>/[\/b]/g;
  } if($alwd{i}) {
    s/<i>/[i]/g;
    s/<\/i>/[\/i]/g;
  } if($alwd{u}) {
    s/<span style=\"text-decoration: underline\">/[u]/g;
    s/<\/span><!--1-->/[\/u]/g;
  } if($alwd{img}) {
    s/<img src=\"([^"\[]+)\" alt=\"\" \/>/\[img\]$1\[\/img\]/g; #" 
    s/<img src=\"([^"\[]+)\" alt=\"([^"\[]+)\" title=\"\2\" \/>/\[img=$1\]$2\[\/img\]/g; #" 
  } if($alwd{email}) {
    s/<a href=\"mailto: ([^\["]+)\">\1<\/a>/\[email\]$1\[\/email\]/g; #"
  } if($alwd{url}) {
    s/<a href=\"([^\]"]+)\">/\[url=$1\]/g; #"
    s/<\/a>/\[\/url\]/g;
  } if($alwd{size}) {
    s/<span style=\"font-size: ([0-9]{1,2})px\">/\[size=$1\]/g;
    s/<\/span><!--2-->/\[\/size\]/g;
  } if($alwd{color}) {
    s/<span style=\"color: ([^"\]\s]+)\">/\[color=$1\]/g; #" 
    s/<\/span><!--3-->/\[\/color\]/g;
  } if($alwd{quote}) {
    s/<span class=\"bbcode_quote_header\">Quote: <span class=\"bbcode_quote_body\">/\[quote\]/g;
    s/<span class=\"bbcode_quote_header\">([^<\]]+) wrote: <span class=\"bbcode_quote_body\">/\[quote=$1\]/g;
    s/<\/span><\/span>/\[\/quote\]/g;
  }
  s/<br \/>\r?\n/\n/g;
  if(!$self->{reverse_for_edit}) {
    s/\&gt\;/>/g;
    s/\&lt\;/</g;
    s/\&amp\;/\&/g;
  }
  
  return $_;
}



## Parses the BB code, list and html tags
sub _bb2html {
  my $self = shift;
  my $str = shift;
  my($acode, $alist, $ahtml) = @_;
  my $return = "";
  
  my $incode = 0; my $inhtml = 0;
  my $inlist = 0; my $liststart = 0;
  while($str =~ /\[(\/?)(code|list|html|\*)=?([^\]])*\](.*)$/ims) {
    $str = $4;
    my($be4, $end, $tag, $opt, $done, $app) = ($`, ($1 eq '/' ? 1 : 0), $2, $3, 0, 0);
   # Parse the stuff before the tag... (if any)
    if($be4 && $incode) {
      if(lc($tag) ne 'code' && !$end) {
        $be4 .= _appendtag($end, $tag, $opt);
        $app++;
      }
      $be4 =~ s/\[/\&#91\;/g;
      $be4 =~ s/\]/\&#93\;/g;
    } elsif($be4 && $inlist && $inlist != $liststart) {
      $be4 = '';
    } elsif($be4 && $inhtml) {
      if(lc($tag) ne 'html' && !$end) {
        $be4 .= _appendtag($end, $tag, $opt);
        $app++;
      }
      $be4 =~ s/<br \/>\r?\n/\n/g;
      $be4 =~ s/\&gt\;/>/g;
      $be4 =~ s/\&lt\;/</g;
      $be4 =~ s/\&amp\;/\&/g;
      $be4 =~ s/\[/\&#91\;/g;
      $be4 =~ s/\]/\&#93\;/g;
    }
    $return .= $be4 if $be4;
   # The [code]-tag
    if($acode && !$inhtml) {
      if(!$incode && lc($tag) eq 'code' && !$end) {
        $return .= "<span class=\"bbcode_code_header\">Code: <span class=\"bbcode_code_body\">";
        $incode = 1;
        $done++;
      } elsif($incode && lc($tag) eq 'code' && $end) {
        $return .= "</span> </span>";
        $incode = 0;
        $done++;
      }
    }
   # The [list] and [*]-tags
    if($alist && !$incode && !$inhtml) {
      if(lc($tag) eq 'list' && !$end) {
        $return .= '</p>' if !$inlist && $self->{in_paragraph};
        $return .= '<ul>' if !$opt;
        $return .= '<ul style="list-style-type: decimal">' if $opt && $opt eq '1';
        $return .= '<ul style="list-style-type: lower-roman">' if $opt && lc($opt) eq 'a';
        $return .= "\n";
        $inlist++;
        $done++;
      } elsif(lc($tag) eq 'list' && $end) {
        $return .= '</li></ul>';
        $return .= '<p>' if $inlist == 1 && $self->{in_paragraph};
        $liststart = --$inlist;
        $done++;
      } elsif(lc($tag) eq '*') {
        $return .= '</li>' if $liststart == $inlist;
        $return .= '<li>';
        $liststart = $inlist;
        $done++;
      }
    }
   # The [html]-tag
    if($ahtml && !$incode) {
      if(!$inhtml && lc($tag) eq 'html' && !$end) {
        $return .= "<!--BB-html-->";
        $inhtml = 1;
        $done++;
      } elsif($inhtml && lc($tag) eq 'html' && $end) {
        $return .= "<!--/BB-html-->";
        $inhtml = 0;
        $done++;
      }
    }
   # When nothing is done with the tag, just add it... (fixes bug added in 0.05)
    $return .= _appendtag($end, $tag, $opt) if !$done && !$app;
  }
  return $return . $str;
}
sub _appendtag {
  my $tag = '[';
  $tag .= '/' if $_[0];
  $tag .= $_[1];
  $tag .= "=$_[2]" if $_[2];
  return "$tag]";
}


sub _html2bb {
  my $self = shift;
  my $str = shift;
  my($acode, $alist, $ahtml) = @_;
  my $return = "";
  
  my $incode = 0; my $inhtml = 0;
  my $inlist = 0;
  $str =~ s/(?:<\/p>|<p>|<\/li>)//g;
 # And this definately is one of the most ugly RegEx-es I've ever written
  while($str =~ /(<span\ class="bbcode_code_header">Code:\ <span\ class="bbcode_code_body">|<\/span>\ <\/span>
        |<ul>|<ul\ style="list-style-type:\ decimal">|<ul\ style="list-style-type:\ lower-roman">|<li>|<\/ul>
        |<!--BB-html-->|<!--\/BB-html-->)(.*)$/xms)
  {
    $str = $2;
    my($be4, $code, $done) = ($`, $1, 0);
   # Parse the stuff before the tag... (if any)
    if($be4 && $inhtml) {
      $be4 .= $code if $code ne '<!--/BB-html-->';
      $be4 =~ s/\&/\&amp\;/g;
      $be4 =~ s/</\&lt\;/g;
      $be4 =~ s/>/\&gt\;/g;
    }
    $return .= $be4 if $be4;
   # The code-tag
    if($acode && !$inhtml) {
      if(!$incode && $code eq '<span class="bbcode_code_header">Code: <span class="bbcode_code_body">') {
        $return .= '[code]';
        $incode = 1;
        $done++;
      } elsif($incode && $code eq '</span> </span>') {
        $return .= '[/code]';
        $incode = 0;
        $done++;
      }
    }
   # The list-tags
    if($alist && !$incode && !$inhtml) {
      if($code eq '<ul>' || $code eq '<ul style="list-style-type: decimal">' || $code eq '<ul style="list-style-type: lower-roman">') {
        $return .= '[list]' if $code eq '<ul>';
        $return .= '[list=1]' if $code eq '<ul style="list-style-type: decimal">';
        $return .= '[list=a]' if $code eq '<ul style="list-style-type: lower-roman">';
        $inlist++;
        $done++;
      } elsif($code eq '</ul>') {
        $return .= '[/list]';
        $inlist--;
        $done++;
      } elsif($code eq '<li>') {
        $return .= '[*]';
        $done++;
      }
    }
   # The html-tag
    if($ahtml && !$incode) {
      if(!$inhtml && $code eq '<!--BB-html-->') {
        $return .= '[html]';
        $inhtml = 1;
        $done++;
      } elsif($inhtml && $code eq '<!--/BB-html-->') {
        $return .= '[/html]';
        $inhtml = 0;
        $done++;
      }
    }
    $return .= $code if !$done && $code ne '<!--/BB-html-->';
  }
  return $return . $str;
}

1;

__END__