AUBBC
view release on metacpan or search on metacpan
package AUBBC;
use strict;
use warnings;
our $VERSION = '4.06';
our $BAD_MESSAGE = 'Unathorized';
our $DEBUG_AUBBC = 0;
our $MEMOIZE = 1;
my $msg = '';
my $aubbc_error = '';
my $long_regex = '[\w\.\/\-\~\@\:\;\=]+(?:\?[\w\~\.\;\:\,\$\-\+\!\*\?\/\=\&\@\#\%]+?)?';
my @do_f = (1,1,1,1,1,0,0,0,time.$$.'000','',1);
my @key64 = ('A'..'Z','a'..'z',0..9,'+','/');
my %SMILEYS = ();
my %Build_AUBBC = ();
my %AUBBC = (
aubbc => 1,
utf => 1,
smileys => 1,
highlight => 1,
$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"' : '';
}
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
}
$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
text - the text or HTML to show if user has no access
Build your own tags has 2 new variables now:
$aubbc->add_build_tag(
name => 'ok',
pattern => 'l,s',
type => 1,
function => 'My_Message::check_ok_tag',
level => 3,
error => 'register to see this',
);
level - the array number of the security level
error - the text or HTML to show if user has no access
For the build tags leaving the variables blank will default level to 0 and
error to the $AUBBC::BAD_MESSAGE string.
=head2 User Access
This method receives the current users security level name from the web application.
$aubbc->user_level('Administrator');
If you are using the tag security you will want to set the user_level after the user
was authenticated by the web application and before do_all_ubbc is used.
type 4 this will use style [name] but will work different then the other built settings
see function below on how type 4 works
function - a pre-defined subroutine that receives the matched pattern, tag name and returns what you want,
unless type is set to 4 then it will replace the tag with what text is in the function.
Note: if the function returns undefined, '' or 0 the tag will not be changed.
level - the array number of the security level
error - the text or HTML to show if user has no access
Note: For the build tags leaving the variables blank will default level to 0 and
error to the $AUBBC::BAD_MESSAGE string.
Usage:
package My_Message;
use AUBBC;
my $aubbc = AUBBC->new();
$aubbc->add_build_tag(
name => 'ok',
=head2 $AUBBC::BAD_MESSAGE
Default message is 'Unathorized', this message is used when the code finds bad characters in [email] or [img] tags.
Usage of this setting:
use AUBBC;
$AUBBC::BAD_MESSAGE = 'Unauthorized use of characters or pattern in this tag.';
# est...
=head2 $aubbc->aubbc_error();
There are two errors for add_build_tag that would die if the wrong input was given
when adding a build tag. The error message will now be stored in this method during
the instance and any new tag that had an error will not be processed.
Since there is only two errors for add_build_tag you can check this method after
all new tags have been added. All errors stack in this method and are seperaited
by a \n newline.
Usage:
$aubbc->aubbc_error('Insert Your Error'); # Add an error
print $aubbc->aubbc_error();
die $aubbc->aubbc_error() if $aubbc->aubbc_error();
=head1 Memoize
This setting can turn AUBBC's usage of Memoize on or off.
=head2 $AUBBC::MEMOIZE
Default setting 1 will check if it needs to load Memoize, if loaded then load the sub's that need the speed.
Setting 0 will not use Memoize.
Fixed - The hash for tag_security() needed the images and link renamed to a tag
name being used. Changed the image name to img and the link to url. Read
"Tag Security Levels" for more info.
Fixed - security for links was in method make_link and was causing an access issue
if used outside of the module. Made a new method to check link access now the
make_link method could be used outside of the module without the security access
in it, as intended.
Changed - forgot to say in version 4.05 that I changed the aubbc_error so a new line
will be added after each inserted error.
v4.05 - 04/05/2011
Addition - Assign security levels for links, images, built and code tags.
New subroutine names: security_levels, user_level, tag_security, check_access
Changed - The default value for $AUBBC::BAD_MESSAGE is now 'Unathorized'
v4.04 - 02/05/2011
Fixed - Bug with quote tag, needed to convert all its tags.
v4.03 - 02/03/2011
Addition - New Object method aubbc_error . Developers can now controle if or when
to handle errors, see the POD 'Error Message' for usage.
Fixed - All built-in tags only convert balanced tags so no unbalanced HTML can
be produced
Fixed - Bug in code_highlight a highlight regex needed to be changed after
version 4.01 to support the Parser style.
Improvement - Small restructure of add_build_tag and change the 'all' setting
of 'pattern' to allow more.
author ment & #59 ; it would show ; . This also caused a long standing bug with
typing any HTML code name and saving it to a backend.
this fix removes the HTML code name regex in do_unicode and had to add/move two
filters in "script_escape to conver the & to an amp and ; to #59;" and
"html_to_text to conver amp to & and #59 to ;". This fix also helped in allowing
the regex's for highlighting subroutines to be made.
Fixed - had to add a null byte marker to escape_aubbc so the code tag's
highlighter can detect the escaped character and change it back. In do_all_ubbc
All markers get removed before the message is returned because FireFox can see
the null bytes as an error.
Addition - Perl subroutine highlighting for the code tag highlighter. Had a
problem making this till this version because a HTML code name can look like
&TheName; and a Perl subroutine looked the same till ; got converted.
Addition - AUBBC::make_image($align,$src,$width,$height,$alt) this is useful enough
to mention once.
v4.00 - 11/02/2010
Fixed - The hash for tag_security() needed the images and link renamed to a tag
name being used. Changed the image name to img and the link to url. Read
"Tag Security Levels" for more info.
Fixed - security for links was in method make_link and was causing an access issue
if used outside of the module. Made a new method to check link access now the
make_link method could be used outside of the module without the security access
in it, as intended.
Changed - forgot to say in version 4.05 that I changed the aubbc_error so a new line
will be added after each inserted error.
v4.05 - 04/05/2011
Addition - Assign security levels for links, images, built and code tags.
New subroutine names: security_levels, user_level, tag_security, check_access
Changed - The default value for $AUBBC::BAD_MESSAGE is now 'Unathorized'
v4.04 - 02/05/2011
Fixed - Bug with quote tag, needed to convert all its tags.
v4.03 - 02/03/2011
Addition - New Object method aubbc_error . Developers can now controle if or when
to handle errors, see the POD 'Error Message' for usage.
Fixed - All built-in tags only convert balanced tags so no unbalanced HTML can
be produced
Fixed - Bug in code_highlight a highlight regex needed to be changed after
version 4.01 to support the Parser style.
Improvement - Small restructure of add_build_tag and change the 'all' setting
of 'pattern' to allow more.
author ment & #59 ; it would show ; . This also caused a long standing bug with
typing any HTML code name and saving it to a backend.
this fix removes the HTML code name regex in do_unicode and had to add/move two
filters in "script_escape to conver the & to an amp and ; to #59;" and
"html_to_text to conver amp to & and #59 to ;". This fix also helped in allowing
the regex's for highlighting subroutines to be made.
Fixed - had to add a null byte marker to escape_aubbc so the code tag's
highlighter can detect the escaped character and change it back. In do_all_ubbc
All markers get removed before the message is returned because FireFox can see
the null bytes as an error.
Addition - Perl subroutine highlighting for the code tag highlighter. Had a
problem making this till this version because a HTML code name can look like
&TheName; and a Perl subroutine looked the same till ; got converted.
Addition - AUBBC::make_image($align,$src,$width,$height,$alt) this is useful enough
to mention once.
v4.00 - 11/02/2010
text - the text or HTML to show if user has no access
Build your own tags has 2 new variables now:
$aubbc->add_build_tag(
name => 'ok',
pattern => 'l,s',
type => 1,
function => 'My_Message::check_ok_tag',
level => 3,
error => 'register to see this',
);
level - the array number of the security level
error - the text or HTML to show if user has no access
For the build tags leaving the variables blank will default level to 0 and
error to the $AUBBC::BAD_MESSAGE string.
=head2 User Access
This method receives the current users security level name from the web application.
$aubbc->user_level('Administrator');
If you are using the tag security you will want to set the user_level after the user
was authenticated by the web application and before do_all_ubbc is used.
type 4 this will use style [name] but will work different then the other built settings
see function below on how type 4 works
function - a pre-defined subroutine that receives the matched pattern, tag name and returns what you want,
unless type is set to 4 then it will replace the tag with what text is in the function.
Note: if the function returns undefined, '' or 0 the tag will not be changed.
level - the array number of the security level
error - the text or HTML to show if user has no access
Note: For the build tags leaving the variables blank will default level to 0 and
error to the $AUBBC::BAD_MESSAGE string.
Usage:
package My_Message;
use AUBBC;
my $aubbc = AUBBC->new();
$aubbc->add_build_tag(
name => 'ok',
=head2 $AUBBC::BAD_MESSAGE
Default message is 'Unathorized', this message is used when the code finds bad characters in [email] or [img] tags.
Usage of this setting:
use AUBBC;
$AUBBC::BAD_MESSAGE = 'Unauthorized use of characters or pattern in this tag.';
# est...
=head2 $aubbc->aubbc_error();
There are two errors for add_build_tag that would die if the wrong input was given
when adding a build tag. The error message will now be stored in this method during
the instance and any new tag that had an error will not be processed.
Since there is only two errors for add_build_tag you can check this method after
all new tags have been added. All errors stack in this method and are seperaited
by a \n newline.
Usage:
$aubbc->aubbc_error('Insert Your Error'); # Add an error
print $aubbc->aubbc_error();
die $aubbc->aubbc_error() if $aubbc->aubbc_error();
=head1 Memoize
This setting can turn AUBBC's usage of Memoize on or off.
=head2 $AUBBC::MEMOIZE
Default setting 1 will check if it needs to load Memoize, if loaded then load the sub's that need the speed.
Setting 0 will not use Memoize.
Fixed - The hash for tag_security() needed the images and link renamed to a tag
name being used. Changed the image name to img and the link to url. Read
"Tag Security Levels" for more info.
Fixed - security for links was in method make_link and was causing an access issue
if used outside of the module. Made a new method to check link access now the
make_link method could be used outside of the module without the security access
in it, as intended.
Changed - forgot to say in version 4.05 that I changed the aubbc_error so a new line
will be added after each inserted error.
v4.05 - 04/05/2011
Addition - Assign security levels for links, images, built and code tags.
New subroutine names: security_levels, user_level, tag_security, check_access
Changed - The default value for $AUBBC::BAD_MESSAGE is now 'Unathorized'
v4.04 - 02/05/2011
Fixed - Bug with quote tag, needed to convert all its tags.
v4.03 - 02/03/2011
Addition - New Object method aubbc_error . Developers can now controle if or when
to handle errors, see the POD 'Error Message' for usage.
Fixed - All built-in tags only convert balanced tags so no unbalanced HTML can
be produced
Fixed - Bug in code_highlight a highlight regex needed to be changed after
version 4.01 to support the Parser style.
Improvement - Small restructure of add_build_tag and change the 'all' setting
of 'pattern' to allow more.
author ment & #59 ; it would show ; . This also caused a long standing bug with
typing any HTML code name and saving it to a backend.
this fix removes the HTML code name regex in do_unicode and had to add/move two
filters in "script_escape to conver the & to an amp and ; to #59;" and
"html_to_text to conver amp to & and #59 to ;". This fix also helped in allowing
the regex's for highlighting subroutines to be made.
Fixed - had to add a null byte marker to escape_aubbc so the code tag's
highlighter can detect the escaped character and change it back. In do_all_ubbc
All markers get removed before the message is returned because FireFox can see
the null bytes as an error.
Addition - Perl subroutine highlighting for the code tag highlighter. Had a
problem making this till this version because a HTML code name can look like
&TheName; and a Perl subroutine looked the same till ; got converted.
Addition - AUBBC::make_image($align,$src,$width,$height,$alt) this is useful enough
to mention once.
v4.00 - 11/02/2010
examples/Database_Manipulation.cgi view on Meta::CPAN
#
# other settings can be changed here if needed.
$aubbc->settings(
script_escape => 0,
);
# Build your own tags can be added, est......
# This will be the data or users input from a HTML form to save to a backend.
# The message will have some characters that would normaly brake some database
# structures, cause risky errors or be html.
my $message = <<FORM;
[b]Work[/b]
<i>This will not work</i>
Brake the database |||| ''''''''''' """"""
FORM
sub saving_data {
# This is to show how to save the user input safely to your backend
examples/tag_list.cgi view on Meta::CPAN
[b]Built Tags[/b][br]
[[google://Google] = [google://Google] Search[br]
[[wp://Wikipedia:About] or [wikipedia://Wikipedia:About] Wikipedia[br]
[[wb://Wikibooks:About] or [wikibooks://Wikibooks:About] Wikibooks[br]
[[wq://Wikiquote:About] or [wikiquote://Wikiquote:About] Wikiquote[br]
[[ws://Wikisource:About_Wikisource] or [wikisource://Wikisource:About_Wikisource] Wikisource[br]
[[cpan://Cpan] = [cpan://Cpan] Cpan Module Search[br]
[[time] = [time]
HTML
# replace the list with any error that may happen
$message = $aubbc->aubbc_error()
? $aubbc->aubbc_error()
: $aubbc->do_all_ubbc($message);
print "Content-type: text/html\n\n";
print <<HTML;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>AUBBC.pm Tag List</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
my ($count, $message, $setting, $aubbc, $Current_version, %msg) =
(1, '[br][utf://#x23]', '', '', '', (1 => 'Test good ', 2 => 'Test error ',) );
BEGIN {
$| = 1;
print "Test's 1 to 4\n";
}
use AUBBC;
$aubbc = new AUBBC;
{
# did it load?
( run in 0.961 second using v1.01-cache-2.11-cpan-65fba6d93b7 )