AUBBC

 view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

}

function MyCodePrint (input) {
 if (input && document.getElementById(input)) {
  var TheCode = document.getElementById(input).innerHTML;
  TheCode = TheCode.replace(/<([^br<]+|\/?[puib])>/ig, "");
  codewin = window.open("", input, "width=800,height=600,resizable=yes,menubar=yes,scrollbars=yes");
  top.codewin.document.write("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n"+
"<html>\n<head>\n<title>MyCodePrint</title>\n"+
"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\n"+
"</head>\n<body>\n<code>"+TheCode+"</code>\n</body>\n</html>\n");
  top.codewin.document.close();
 }
}
JS
exit(0);
}

sub do_build_tag {
 warn 'ENTER do_build_tag' if $DEBUG_AUBBC;

 foreach (keys %Build_AUBBC) {
  warn 'ENTER foreach do_build_tag' if $DEBUG_AUBBC;
  $msg =~ s/(\[$_\:\/\/([$Build_AUBBC{$_}[0]]+)\])/
   do_sub( $_, $2 , $Build_AUBBC{$_}[2] ) || $1;
  /eg if $Build_AUBBC{$_}[1] eq '1';

  $msg =~ s/(\[$_\](?s)([$Build_AUBBC{$_}[0]]+)\[\/$_\])/
   do_sub( $_, $2 , $Build_AUBBC{$_}[2] ) || $1;
  /eg if $Build_AUBBC{$_}[1] eq '2';

  $msg =~ s/(\[$_\])/
   do_sub( $_, '' , $Build_AUBBC{$_}[2] ) || $1;
  /eg if $Build_AUBBC{$_}[1] eq '3';

  $msg =~ s/\[$_\]/
   check_access($_) ? $Build_AUBBC{$_}[2] : $Tag_SecLVL{$_}{text};
  /eg if $Build_AUBBC{$_}[1] eq '4';
 }
}

sub do_sub {
 my ($key, $term, $fun) = @_;
 warn 'ENTER do_sub' if $DEBUG_AUBBC;
 check_access($key)
  ? return $fun->($key, $term) || ''
  : return $Tag_SecLVL{$key}{text};
}

sub check_subroutine {
 my $name = shift;
 defined $name && exists &{$name} && (ref $name eq 'CODE' || ref $name eq '')
   ? return \&{$name}
   : return '';
}

sub add_build_tag {
 my ($self,%NewTag) = @_;
 warn 'ENTER add_build_tag' if $DEBUG_AUBBC;
 
 $NewTag{function2} = $NewTag{function} || 'undefined!';
 $NewTag{function} = check_subroutine($NewTag{function},'')
  if $NewTag{type} ne '4';
 
 $self->aubbc_error("Usage: add_build_tag - function 'Undefined subroutine' => $NewTag{function2}")
  if ! $NewTag{function};
 
 if ($NewTag{function}) {
  $NewTag{pattern} = 'l' if $NewTag{type} eq '3' || $NewTag{type} eq '4';
  if ($NewTag{type} && $NewTag{name} =~ m/\A[\w\-]+\z/ && $NewTag{pattern} =~ m/\A[lns_:\-,]+|all\z/) {
  
    if ($NewTag{pattern} eq 'all') {
     $NewTag{pattern} = '^\[|\]';
    }
     else {
     my @pat_split = ();
     my %is_pat = ('l' => 'a-z', 'n' => '\d', '_' => '\_', ':' => '\:', 's' => '\s', '-' => '\-');
     @pat_split = split /\,/, $NewTag{pattern};
     $NewTag{pattern} = '';
     $NewTag{pattern} .= $is_pat{$_} || '' foreach @pat_split;
    }
   
   $Build_AUBBC{$NewTag{name}} = [$NewTag{pattern}, $NewTag{type}, $NewTag{function}];
   $NewTag{level}  ||= 0;
   $NewTag{error}  ||= $BAD_MESSAGE;
   $Tag_SecLVL{$NewTag{name}}  = {level => $NewTag{level}, text => $NewTag{error},};
   $do_f[5] = 1 if !$do_f[5];
   warn 'Added Build_AUBBC Tag '.$Build_AUBBC{$NewTag{name}} if $DEBUG_AUBBC && $Build_AUBBC{$NewTag{name}};
  }
   else {
   $self->aubbc_error('Usage: add_build_tag - Bad name or pattern format');
  }
 }
}

sub remove_build_tag {
 my ($self,$name,$type) = @_;
 warn 'ENTER remove_build_tag' if $DEBUG_AUBBC;
 delete $Build_AUBBC{$name} if exists $Build_AUBBC{$name} && !$type; # clear one
 %Build_AUBBC = () if $type && !$name; # clear all
}

sub do_unicode{
 warn 'ENTER do_unicode' if $DEBUG_AUBBC;
 $msg =~ s/\[utf:\/\/(\#?\w+)\]/&$1;/g;
}

sub do_smileys {
warn 'ENTER do_smileys' if $DEBUG_AUBBC;
$msg =~
 s/\[$_\]/make_image('',"$AUBBC{images_url}\/smilies\/$SMILEYS{$_}",'','',$_).$AUBBC{image_wrap}/ge
 foreach keys %SMILEYS;
}

sub smiley_hash {
 my ($self,%s_hash) = @_;
 warn 'ENTER smiley_hash' if $DEBUG_AUBBC;
 if (keys %s_hash) {
 %SMILEYS = %s_hash;
 $do_f[6] = 1;
 }



( run in 1.568 second using v1.01-cache-2.11-cpan-d80b1682f3f )