AUBBC
view release on metacpan or search on metacpan
}
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 )