AUBBC

 view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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,

AUBBC.pm  view on Meta::CPAN

111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
  $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.pm  view on Meta::CPAN

422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
}
 
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
}

AUBBC.pm  view on Meta::CPAN

579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
  $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

AUBBC.pod  view on Meta::CPAN

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
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.

AUBBC.pod  view on Meta::CPAN

528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
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',

AUBBC.pod  view on Meta::CPAN

611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
=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.

AUBBC.pod  view on Meta::CPAN

700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
 
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.

AUBBC.pod  view on Meta::CPAN

753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
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

CHANGES  view on Meta::CPAN

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
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.

CHANGES  view on Meta::CPAN

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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

README  view on Meta::CPAN

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
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.

README  view on Meta::CPAN

528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
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',

README  view on Meta::CPAN

611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
=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.

README  view on Meta::CPAN

700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
 
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.

README  view on Meta::CPAN

753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
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

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
#
# 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

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
[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" />

test.pl  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# 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?