File Coverage

blib/lib/HTML/BBReverse.pm

Criterion	Covered	Total	%
statement	189	220	85.9
branch	84	136	61.7
condition	68	126	53.9
subroutine	10	10	100.0
pod	3	3	100.0
total	354	495	71.5

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/\&/\&\;/g;
  s/
  s/>/\>\;/g;
  s/\r?\n/\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\]//ig;
    s/\[\/b\]/<\/b>/ig;
  } if($alwd{i}) {
    s/\[i\]//ig;
    s/\[\/i\]/<\/i>/ig;
  } if($alwd{u}) {
    s/\[u\]//ig;
    s/\[\/u\]/<\/span>/ig;
  } if($alwd{img}) {
    s/\[img\]([^"\[]+)\[\/img\]/"_fix_jslink($1) . "\" alt=\"\" \/>"/eig; #"
    s/\[img=([^"\]]+)\]([^"\[]+)\[\/img\]/"_fix_jslink($1) . "\" alt=\"$2\" title=\"$2\" \/>"/eig; #"
  } if($alwd{url}) {
    s/\[url=([^\]"]+)\]/"_fix_jslink($1) . "\">"/ieg;
    s/\[\/url\]/<\/a>/ig;
  } if($alwd{email}) {
    s/\[email\]([^"\[]+)\[\/email\]/$1<\/a>/ig; #"
  } if($alwd{size}) {
    s/\[size=([0-9]{1,2})\]//ig;
    s/\[\/size\]/<\/span>/ig;
  } if($alwd{color}) {
    s/\[color=([^"\]\s]+)\]//ig;  #"
    s/\[\/color\]/<\/span>/ig;
  } if($alwd{quote}) {
    s/\[quote\]/Quote: /ig;
    s/\[quote=([^<\]]+)\]/$1 wrote: /ig;
    s/\[\/quote\]/<\/span><\/span>/ig;
  }
  s/\[\;/[/g;
  s/\]\;/]/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]/g;
    s/<\/b>/[\/b]/g;
  } if($alwd{i}) {
    s//[i]/g;
    s/<\/i>/[\/i]/g;
  } if($alwd{u}) {
    s//[u]/g;
    s/<\/span>/[\/u]/g;
  } if($alwd{img}) {
    s//\[img\]$1\[\/img\]/g; #"
    s//\[img=$1\]$2\[\/img\]/g; #"
  } if($alwd{email}) {
    s/\1<\/a>/\[email\]$1\[\/email\]/g; #"
  } if($alwd{url}) {
    s//\[url=$1\]/g; #"
    s/<\/a>/\[\/url\]/g;
  } if($alwd{size}) {
    s//\[size=$1\]/g;
    s/<\/span>/\[\/size\]/g;
  } if($alwd{color}) {
    s//\[color=$1\]/g; #"
    s/<\/span>/\[\/color\]/g;
  } if($alwd{quote}) {
    s/Quote: /\[quote\]/g;
    s/([^<\]]+) wrote: /\[quote=$1\]/g;
    s/<\/span><\/span>/\[\/quote\]/g;
  }
  s/\r?\n/\n/g;
  if(!$self->{reverse_for_edit}) {
    s/\>\;/>/g;
    s/\<\;/
    s/\&\;/\&/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/\[/\[\;/g;
      $be4 =~ s/\]/\]\;/g;
    } elsif($be4 && $inlist && $inlist != $liststart) {
      $be4 = '';
    } elsif($be4 && $inhtml) {
      if(lc($tag) ne 'html' && !$end) {
        $be4 .= _appendtag($end, $tag, $opt);
        $app++;
      }
      $be4 =~ s/\r?\n/\n/g;
      $be4 =~ s/\>\;/>/g;
      $be4 =~ s/\<\;/
      $be4 =~ s/\&\;/\&/g;
      $be4 =~ s/\[/\[\;/g;
      $be4 =~ s/\]/\]\;/g;
    }
    $return .= $be4 if $be4;
   # The [code]-tag
    if($acode && !$inhtml) {
      if(!$incode && lc($tag) eq 'code' && !$end) {
        $return .= "Code: ";
        $incode = 1;
        $done++;
      } elsif($incode && lc($tag) eq 'code' && $end) {
        $return .= " ";
        $incode = 0;
        $done++;
      }
    }
   # The [list] and [*]-tags
    if($alist && !$incode && !$inhtml) {
      if(lc($tag) eq 'list' && !$end) {
        $return .= '' if !$inlist && $self->{in_paragraph};
        $return .= '' if !$opt;
        $return .= '' if $opt && $opt eq '1';
        $return .= '' if $opt && lc($opt) eq 'a';
        $return .= "\n";
        $inlist++;
        $done++;
      } elsif(lc($tag) eq 'list' && $end) {
        $return .= '';
        $return .= '' if $inlist == 1 && $self->{in_paragraph};
        $liststart = --$inlist;
        $done++;
      } elsif(lc($tag) eq '*') {
        $return .= '' if $liststart == $inlist;
        $return .= '';
        $liststart = $inlist;
        $done++;
      }
    }
   # The [html]-tag
    if($ahtml && !$incode) {
      if(!$inhtml && lc($tag) eq 'html' && !$end) {
        $return .= "";
        $inhtml = 1;
        $done++;
      } elsif($inhtml && lc($tag) eq 'html' && $end) {
        $return .= "";
        $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>||<\/li>)//g;
 # And this definately is one of the most ugly RegEx-es I've ever written
  while($str =~ /(Code:\ |<\/span>\ <\/span>
    |||||<\/ul>
    ||)(.*)$/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 '';
      $be4 =~ s/\&/\&\;/g;
      $be4 =~ s/
      $be4 =~ s/>/\>\;/g;
    }
    $return .= $be4 if $be4;
   # The code-tag
    if($acode && !$inhtml) {
      if(!$incode && $code eq 'Code: ') {
        $return .= '[code]';
        $incode = 1;
        $done++;
      } elsif($incode && $code eq ' ') {
        $return .= '[/code]';
        $incode = 0;
        $done++;
      }
    }
   # The list-tags
    if($alist && !$incode && !$inhtml) {
      if($code eq '' || $code eq '' || $code eq '') {
        $return .= '[list]' if $code eq '';
        $return .= '[list=1]' if $code eq '';
        $return .= '[list=a]' if $code eq '';
        $inlist++;
        $done++;
      } elsif($code eq '') {
        $return .= '[/list]';
        $inlist--;
        $done++;
      } elsif($code eq '') {
        $return .= '[*]';
        $done++;
      }
    }
   # The html-tag
    if($ahtml && !$incode) {
      if(!$inhtml && $code eq '') {
        $return .= '[html]';
        $inhtml = 1;
        $done++;
      } elsif($inhtml && $code eq '') {
        $return .= '[/html]';
        $inhtml = 0;
        $done++;
      }
    }
    $return .= $code if !$done && $code ne '';
  }
  return $return . $str;
}

1;

__END__