view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

sub security_levels {
 my ($self,@s_levels) = @_;
 $do_f[10] = 0;
 @s_levels
  ? @security_levels = @s_levels
  : return @security_levels;
}

sub user_level {
 my ($self,$u_level) = @_;
 $do_f[10] = 0;
 defined $u_level
  ? $user_level = $u_level
  : return $user_level;
}

sub tag_security {
 my ($self,%s_tags) = @_;
 %s_tags
  ? %Tag_SecLVL = %s_tags
  : return %Tag_SecLVL;
}

sub check_access {
 my $tag = shift;
 unless ($do_f[10]) {
  $do_f[10] = 1;
  ($high_level, $user_key) = (scalar(@security_levels), 0);

  for(my $i = 0; $i < $high_level;) {
   if ($security_levels[$i] eq $user_level) {
    $user_key = $i;
    last;
    }
   $i++;
  }
 }
 
 if (defined $tag && $do_f[10]) {
  $user_key >= $Tag_SecLVL{$tag}{level}
   ? return 1
   : return '';
 }
}

sub new {
warn 'CREATING AUBBC '.$VERSION if $DEBUG_AUBBC;
 if ($MEMOIZE && ! $do_f[7]) {
  $do_f[7] = 1;
  eval 'use Memoize' if ! defined $Memoize::VERSION;
  unless ($@ || ! defined $Memoize::VERSION) {
   Memoize::memoize('AUBBC::settings');
   Memoize::memoize('AUBBC::smiley_hash');
   Memoize::memoize('AUBBC::add_build_tag');
   Memoize::memoize('AUBBC::do_all_ubbc');
   Memoize::memoize('AUBBC::script_escape');
   Memoize::memoize('AUBBC::html_to_text');
  }
   $aubbc_error .= $@."\n" if $@;
 }
return bless {};
}

sub DESTROY {
warn 'DESTROY AUBBC '.$VERSION if $DEBUG_AUBBC;
}

sub settings_prep {
$AUBBC{href_target}  = $AUBBC{href_target} ? ' target="_blank"' : '';
$AUBBC{image_wrap}   = $AUBBC{image_wrap} ? ' ' : '';
$AUBBC{image_border} = $AUBBC{image_border} ? '1' : '0';
$AUBBC{html_type}    = $AUBBC{html_type} eq 'xhtml' || $AUBBC{html_type} eq ' /' ? ' /' : '';
}

sub settings {
 my ($self,%s_hash) = @_;
  foreach (keys %s_hash) {
   if ('highlight_function' eq $_) {
    $AUBBC{highlight} = 0;
    $s_hash{$_} = check_subroutine($s_hash{$_},'');
    $AUBBC{highlight_function} = $s_hash{$_} unless ! $s_hash{$_};
   } else {
    $AUBBC{$_} = $s_hash{$_};
   }
  }
 &settings_prep;
 if ($DEBUG_AUBBC) {
  my $uabbc_settings = '';
  $uabbc_settings .= $_ . ' =>' . $AUBBC{$_} . ', ' foreach keys %AUBBC;
  warn 'AUBBC Settings Change: '.$uabbc_settings;
 }
}

sub get_setting {
 my ($self,$name) = @_;
 return $AUBBC{$name} if exists $AUBBC{$name};
}

sub code_highlight {
 my $txt = shift;
 warn 'ENTER code_highlight' if $DEBUG_AUBBC;
 $txt =~ s/:/&#58;/g;
 $txt =~ s/\[/&#91;/g;
 $txt =~ s/\]/&#93;/g;
 $txt =~ s/\000&#91;/&#91;&#91;/g;
 $txt =~ s/\000&#93;/&#93;&#93;/g;
 $txt =~ s/\{/&#123;/g;
 $txt =~ s/\}/&#125;/g;
 $txt =~ s/%/&#37;/g;
 $txt =~ s/(?<!>)\n/<br$AUBBC{html_type}>\n/g;
 if ($AUBBC{highlight}) {
  warn 'ENTER block highlight' if $DEBUG_AUBBC;
  $txt =~ s/\z/<br$AUBBC{html_type}>/ if $txt !~ m/<br$AUBBC{html_type}>\z/;
  $txt =~ s/(&#60;&#60;(?:&#39;)?(\w+)(?:&#39;)?&#59;(?s)[^\2]+\b\2\b)/<span$AUBBC{highlight_class1}>$1<\/span>/g;
  $txt =~ s/(?<![\&\$])(\#.*?(?:<br$AUBBC{html_type}>))/<span$AUBBC{highlight_class2}>$1<\/span>/g;
  $txt =~ s/(\bsub\b(?:\s+))(\w+)/$1<span$AUBBC{highlight_class8}>$2<\/span>/g;
  $txt =~ s/(\w+(?:\-&#62;)?(?:\w+)?&#40;(?:.+?)?&#41;(?:&#59;)?)/<span$AUBBC{highlight_class9}>$1<\/span>/g;
  $txt =~ s/((?:&amp;)\w+&#59;)/<span$AUBBC{highlight_class9}>$1<\/span>/g;
  $txt =~ s/(&#39;(?s).*?(?<!&#92;)&#39;)/<span$AUBBC{highlight_class3}>$1<\/span>/g;
  $txt =~ s/(&#34;(?s).*?(?<!&#92;)&#34;)/<span$AUBBC{highlight_class4}>$1<\/span>/g;
  $txt =~ s/(?<![\#|\w])(\d+)(?!\w)/<span$AUBBC{highlight_class5}>$1<\/span>/g;