view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

  $txt =~
s/(&#124;&#124;|&amp;&amp;|\b(?:strict|package|return|require|for|my|sub|if|eq|ne|lt|ge|le|gt|or|xor|use|while|foreach|next|last|unless|elsif|else|not|and|until|continue|do|goto)\b)/<span$AUBBC{highlight_class6}>$1<\/span>/g;
  $txt =~ s/(?<!&#92;)((?:&#37;|\$|\@)\w+(?:(?:&#91;.+?&#93;|&#123;.+?&#125;)+|))/<span$AUBBC{highlight_class7}>$1<\/span>/g;
 }
 return $txt;
}

sub code_download {
 if ($AUBBC{code_download}) {
  $do_f[8]++;
  $do_f[9] =
   make_link('javascript:void(0)',$AUBBC{code_download}, "javascript:MyCodePrint('aubbcode$do_f[8]');",'');
  return " id=\"aubbcode$do_f[8]\"";
 } else { return ''; }
}

sub code_tag {
 my ($code,$name) = @_;
 if (check_access('code')) {
 $name = "# $name:<br$AUBBC{html_type}>\n" if $name;
 return "$name<div$AUBBC{code_class}".&code_download."><code>\n".
$AUBBC{highlight_function}->($code).
"\n</code></div>".$AUBBC{code_extra}.$do_f[9];
 }
  else {
   return $Tag_SecLVL{code}{text};
   }
}

sub make_image {
my ($align,$src,$width,$height,$alt) = @_;
 my $img = "<img$align src=\"$src\"";
 $img .= " width=\"$width\"" if $width;
 $img .= " height=\"$height\"" if $height;
 return $img." alt=\"$alt\" border=\"$AUBBC{image_border}\"$AUBBC{html_type}>";
}

sub make_link {
 my ($link,$name,$javas,$targ) = @_;
 my $linkd = "<a href=\"$link\"";
 $linkd .= " onclick=\"$javas\"" if $javas;
 $linkd .= $AUBBC{href_target} if $targ;
 $linkd .= $AUBBC{href_class}.'>';
 $linkd .= $name ? $name : $link;
 return $linkd.'</a>';
}

sub do_ubbc {
 warn 'ENTER do_ubbc' if $DEBUG_AUBBC;
 $msg =~ s/\[(?:c|code)\](?s)(.+?)\[\/(?:c|code)\]/code_tag($1, '')/ge;
 $msg =~ s/\[(?:c|code)=(.+?)\](?s)(.+?)\[\/(?:c|code)\]/code_tag($2, $1)/ge;
 $do_f[9] = '' if $do_f[9];

 $msg =~ s/\[(img|right_img|left_img)\](.+?)\[\/img\]/fix_image($1, $2)/ge if ! $AUBBC{no_img};

 $msg =~ s/\[email\](?![\w\.\-\&\+]+\@[\w\.\-]+).+?\[\/email\]/\[<font color=red>$BAD_MESSAGE<\/font>\]email/g;
 $AUBBC{protect_email}
  ? $msg =~ s/\[email\]([\w\.\-\&\+]+\@[\w\.\-]+)\[\/email\]/protect_email($1)/ge
  : $msg =~ s/\[email\]([\w\.\-\&\+]+\@[\w\.\-]+)\[\/email\]/link_check("mailto:$1",$1,'','')/ge;

 $msg =~ s/\[color=([\w#]+)\](?s)(.+?)\[\/color\]/<span style="color:$1;">$2<\/span>/g;

 1 while $msg =~
  s/\[quote=([\w\s]+)\](?s)(.+?)\[\/quote\]/<div$AUBBC{quote_class}><small><strong>$1:<\/strong><\/small><br$AUBBC{html_type}>
$2<\/div>$AUBBC{quote_extra}/g;
 1 while $msg =~
  s/\[quote\](?s)(.+?)\[\/quote\]/<div$AUBBC{quote_class}>$1<\/div>$AUBBC{quote_extra}/g;

 $msg =~ s/\[(left|right|center)\](?s)(.+?)\[\/\1\]/<div style=\"text-align: $1;\">$2<\/div>/g;
 $msg =~ s/\[li=(\d+)\](?s)(.+?)\[\/li\]/<li value="$1">$2<\/li>/g;
 $msg =~ s/\[u\](?s)(.+?)\[\/u\]/<span style="text-decoration: underline;">$1<\/span>/g;
 $msg =~ s/\[strike\](?s)(.+?)\[\/strike\]/<span style="text-decoration: line-through;">$1<\/span>/g;
 $msg =~ s/\[([bh]r)\]/<$1$AUBBC{html_type}>/g;
 $msg =~ s/\[list\](?s)(.+?)\[\/list\]/fix_list($1)/ge;

 1 while $msg =~
  s/\[(blockquote|big|h[123456]|[ou]l|li|em|pre|s(?:mall|trong|u[bp])|[bip])\](?s)(.+?)\[\/\1\]/<$1>$2<\/$1>/g;
 
 $msg =~ s/(<\/?(?:ol|ul|li|hr)\s?\/?>)\r?\n?<br(?:\s?\/)?>/$1/g;

 $msg =~ s/\[url=(\w+\:\/\/$long_regex)\](.+?)\[\/url\]/link_check($1,fix_message($2),'',1)/ge;
 $msg =~ s/(?<!["=\.\/\'\[\{\;])((?:\b\w+\b\:\/\/)$long_regex)/link_check($1,$1,'',1)/ge;
}

sub link_check {
 my ($link,$name,$javas,$targ) = @_;
 check_access('url')
  ? make_link($link,$name,$javas,$targ)
  : return $Tag_SecLVL{url}{text};
}

sub fix_list {
my $list = shift;
 if ($list =~ m/\[\*/) {
 $list =~ s/<br$AUBBC{html_type}>//g;
 my $type = 'ul';
 $type = 'ol' if $list =~ s/\[\*=(\d+)\]/\[\*\]$1\|/g;
  my @clean = split('\[\*\]', $list);
  $list = "<$type>\n";
  foreach (@clean) {
   if ($_ && $_ =~ s/\A(\d+)\|(?s)(.+?)/$2/) {
    $list .= "<li value=\"$1\">$_<\/li>\n" if $_ !~ m/\A\r?\n?\z/;
   } elsif ($_ && $_ !~ m/\A\s+|\d+\|\r?\n?\z/) {
    $list .= "<li>$_<\/li>\n";
    }
  }
  $list .= "<\/$type>";
 }
 return $list;
}

sub fix_image {
 my ($tmp2, $tmp) = @_;
 if (check_access('img')) {
 if ($tmp !~ m/\A\w+:\/\/|\// || $tmp =~ m/\?|\#|\.\bjs\b\z/i) {
  $tmp = "[<font color=red>$BAD_MESSAGE</font>]$tmp2";
 }
  else {
  $tmp2 = '' if $tmp2 eq 'img';
  $tmp2 = ' align="right"' if $tmp2 eq 'right_img';
  $tmp2 = ' align="left"' if $tmp2 eq 'left_img';
  $tmp = $AUBBC{icon_image}
   ? make_link($tmp,make_image($tmp2,$tmp,$AUBBC{image_width},
      $AUBBC{image_hight},''),'',1).$AUBBC{image_wrap}
   : make_image($tmp2,$tmp,'','','').$AUBBC{image_wrap};
 }
 return $tmp;
 }
  else {
   return $Tag_SecLVL{img}{text};
   }
}