view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

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,
    highlight_function  => \&code_highlight,
    no_bypass           => 0,
    for_links           => 0,
    aubbc_escape        => 1,
    no_img              => 0,
    icon_image          => 1,
    image_hight         => '60',
    image_width         => '90',
    image_border        => '0',
    image_wrap          => ' ',
    href_target         => ' target="_blank"',
    images_url          => '',
    html_type           => ' /',
    fix_amp             => 1,
    line_break          => '1',
    code_class          => '',
    code_extra          => '',
    code_download       => '^Download above code^',
    href_class          => '',
    quote_class         => '',
    quote_extra         => '',
    script_escape       => 1,
    protect_email       => '0',
    email_message       => 'Contact Email',
    highlight_class1    => '',
    highlight_class2    => '',
    highlight_class3    => '',
    highlight_class4    => '',
    highlight_class5    => '',
    highlight_class6    => '',
    highlight_class7    => '',
    highlight_class8    => '',
    highlight_class9    => '',
    );
my @security_levels = ('Guest', 'User', 'Moderator','Administrator');
my ($user_level, $high_level, $user_key) = ('Guest', 3, 0);
my %Tag_SecLVL = (
    code                => { level => 0, text => $BAD_MESSAGE, },
    img                 => { level => 0, text => $BAD_MESSAGE, },
    url                 => { level => 0, text => $BAD_MESSAGE, },
    );

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;
 }

AUBBC.pm  view on Meta::CPAN

1;

__END__

=pod

=head1 COPYLEFT

AUBBC.pm, v4.06 4/12/2011 By: N.K.A.

Advanced Universal Bulletin Board Code a Perl BBcode API

shakaflex [at] gmail.com

http://search.cpan.org/~sflex/

http://aubbc.googlecode.com/

Development Notes: Highlighting functions list and tags/commands for more
language highlighters. Ideas make some new tags like [perl] or have a command in the code
tag like [code]perl:print 'perl';[/code] with a default highlighting method if
a command was not used. Then highlighting of many types of code could be allowed
even markup like HTML.

Notes: This code has a lot of settings and works good
with most default settings see the POD and example files
in the archive for usage.

=head1 NAME

AUBBC

=head1 SYNOPSIS

  use AUBBC;
  my $aubbc = AUBBC->new();

  my $message = 'Lets [b]Bold in HTML[/b]';

  print $aubbc->do_all_ubbc($message);

=head1 ABSTRACT

Advanced Universal Bulletin Board Code a Perl BBcode API

=head1 DESCRIPTION

AUBBC is a object oriented BBcode API designed as a developers tool for themes, wiki's, forums and other BBcode to HTML Parser needs.

Features:

1) Massive amount of supported tags.

2) Build your own tags to add custom made tags.

3) Full XSS Security for supported tags.

4) High Speed Parser

5) Assign security levels for links, images, build and code tags.

6) Protection for emails to hide them from harvesters.

7) Code download for code tags

8) Perl code highlighter in the code tags

9) Fully customizable settings.

The advantage of using this BBcode is to have the piece of mind of using a secure program,
to restrict the usage of HTML/XHTML elements and to make formatting of posts easy to people that have no HTML/XHTML skill.
Most sites that use these tags show a list of them and/or easy way to insert the tags to the form field by the user.

The [c] or code tags can highlight Perl code, highlighting the Perl code with CSS in HTML/XHTML,
and in the examples folder the tag_list.cgi file has a CSS code you could work from and now a setting to change to a costume highlighter function.
This module addresses many security issues the BBcode tags may have mainly cross site script also known as XSS.
Each message is escaped before it gets returned if script_escape is Enabled and checked for many types of security problems before that tag converts to HTML/XHTML.
The script_escape setting and method also converts the ' sign so the text can be stored in a SQL back-end.
Most of the free web portals use the | sign as the delimiter for the flat file database, the script_escape setting and method also converts that sign so the structure of the database is retained.

Allows easy conversion to HTML and XHTML, existing tags will convert to the HTML type set.

If there isn't a popular tag available this module provides a method to "Build your own tags" custom tags can help link to parts of the current web page, other web pages and add other HTML elements.


=cut