view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

 $do_f[6] = 1;
 }
}

sub do_all_ubbc {
 my ($self,$message) = @_;
 warn 'ENTER do_all_ubbc' if $DEBUG_AUBBC;
 $msg = defined $message ? $message : '';
 if ($msg) {
  check_access();
  $msg = $self->script_escape($msg,'') if $AUBBC{script_escape};
  $msg =~ s/&(?!\#?\w+;)/&/g if $AUBBC{fix_amp};
  if (!$AUBBC{no_bypass} && $msg =~ m/\A\#no/) {
   $do_f[4] = 0 if $msg =~ s/\A\#none//;
   if ($do_f[4]) {
   $do_f[0] = 0 if $msg =~ s/\A\#noubbc//;
   $do_f[1] = 0 if $msg =~ s/\A\#nobuild//;
   $do_f[2] = 0 if $msg =~ s/\A\#noutf//;
   $do_f[3] = 0 if $msg =~ s/\A\#nosmileys//;
   }
   warn 'START no_bypass' if $DEBUG_AUBBC && !$do_f[4];
  }
  if ($do_f[4]) {
   escape_aubbc() if $AUBBC{aubbc_escape};
   if (!$AUBBC{for_links}) {
    do_ubbc($msg) if $do_f[0] && $AUBBC{aubbc};
    do_build_tag() if $do_f[5] && $do_f[1];
   }
   do_unicode() if $do_f[2] && $AUBBC{utf};
   do_smileys() if $do_f[6] && $do_f[3] && $AUBBC{smileys};
  }
 }
 $msg =~ tr/\000//d if $AUBBC{aubbc_escape};
 return $msg;
}

sub fix_message {
 my $txt = shift;
 $txt =~ s/\././g;
 $txt =~ s/\:/:/g;
 return $txt;
}
sub escape_aubbc {
 warn 'ENTER escape_aubbc' if $DEBUG_AUBBC;
 $msg =~ s/\[\[/\000[/g;
 $msg =~ s/\]\]/\000]/g;
}

sub script_escape {
 my ($self, $text, $option) = @_;
 warn 'ENTER html_escape' if $DEBUG_AUBBC;
 $text = '' unless defined $text;
 if ($text) {
  $text =~ s/(&|;)/$1 eq '&' ? '&' : '&#59;'/ge;
  if (!$option) {
   $text =~ s/\t/ \  \  \ /g;
   $text =~ s/  / \ /g;
  }
  $text =~ s/"/"/g;
  $text =~ s/</&#60;/g;
  $text =~ s/>/&#62;/g;
  $text =~ s/'/&#39;/g;
  $text =~ s/\)/&#41;/g;
  $text =~ s/\(/&#40;/g;
  $text =~ s/\\/&#92;/g;
  $text =~ s/\|/&#124;/g;
  ! $option && $AUBBC{line_break} eq '2'
   ? $text =~ s/\n/<br$AUBBC{html_type}>/g
   : $text =~ s/\n/<br$AUBBC{html_type}>\n/g if !$option && $AUBBC{line_break} eq '1';
  return $text;
 }
}

sub html_to_text {
 my ($self, $html, $option) = @_;
 warn 'ENTER html_to_text' if $DEBUG_AUBBC;
 $html = '' unless defined $html;
 if ($html) {
  $html =~ s/&amp;/&/g;
  $html =~ s/&#59;/;/g;
  if (!$option) {
   $html =~ s/ \&nbsp; \&nbsp; \&nbsp;/\t/g;
   $html =~ s/ \&nbsp;/  /g;
  }
  $html =~ s/&#34;/"/g;
  $html =~ s/&#60;/</g;
  $html =~ s/&#62;/>/g;
  $html =~ s/&#39;/'/g;
  $html =~ s/&#41;/\)/g;
  $html =~ s/&#40;/\(/g;
  $html =~ s/&#92;/\\/g;
  $html =~ s/&#124;/\|/g;
  $html =~ s/<br(?:\s?\/)?>\n?/\n/g if $AUBBC{line_break};
  return $html;
 }
}

sub version {
 my $self = shift;
 return $VERSION;
}

sub aubbc_error {
 my ($self, $error) = @_;
 defined $error && $error
  ? $aubbc_error .= $error . "\n"
  : return $aubbc_error;
}

1;

__END__

=pod

=head1 COPYLEFT

AUBBC.pm, v4.06 4/12/2011 By: N.K.A.

Advanced Universal Bulletin Board Code a Perl BBcode API

shakaflex [at] gmail.com

http://search.cpan.org/~sflex/

http://aubbc.googlecode.com/

Development Notes: Highlighting functions list and tags/commands for more
language highlighters. Ideas make some new tags like [perl] or have a command in the code
tag like [code]perl:print 'perl';[/code] with a default highlighting method if
a command was not used. Then highlighting of many types of code could be allowed
even markup like HTML.

Notes: This code has a lot of settings and works good
with most default settings see the POD and example files
in the archive for usage.

=head1 NAME

AUBBC

=head1 SYNOPSIS

  use AUBBC;
  my $aubbc = AUBBC->new();

  my $message = 'Lets [b]Bold in HTML[/b]';