Re: Bench this BBcode Part 2

[jwkrahn]

$ grep -e /o -e /go -e /io -o AUBBC.pm | wc -l
89

You are using the /o option 89 times, mostly on regular expressions that do not contain variables, but the /o option is only useful on regular expressions that do contain variables.    Perhaps you should read: What is /o really for?

     12 my %AUBBC = (aubbc => 1,utf => 1,smileys => 1,highlight => 1,h
+ighlight_function => \&{code_highlight},no_bypass => 0,for_links => 0
+,aubbc_escape => 1,no

It is more readable to put one key/value pair per line, for example like:

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          => '',
    href_class          => '',
    quote_class         => '',
    quote_extra         => '',
    script_escape       => 1,
    protect_email       => 0,
    email_message       => 'Contact&#3
+2;Email',
    highlight_class1    => '',
    highlight_class2    => '',
    highlight_class3    => '',
    highlight_class4    => '',
    highlight_class5    => '',
    highlight_class6    => '',
    highlight_class7    => '',
    );

     14 my $long_regex = '[\w\.\/\-\~\@\:\;\=]+(?:\?[\w\~\.\;\:\,\$\-\
++\!\*\?\/\=\&\@\#\%]+?)?';

Perhaps you should compile this once with the qr operator instead of every time you use it?

     15 my @key64 = ('A','B','C','D','E','F','G','H','I','J','K','L','
+M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d
+','e','f','g','h','i'

That is usually written as:

my @key64 = ( 'A' .. 'Z', 'a' .. 'z', 0 .. 9, '+', '/' );

     42 sub settings {
     43  my ($self,%s_hash) = @_;
     44  if (keys %s_hash) {
     45   foreach (keys %s_hash) {
     46    if ('highlight_function' eq $_) {
     47     my $is_ok = check_subroutine($s_hash{$_}) || '';
     48     $AUBBC{highlight} = 0;
     49     $AUBBC{highlight_function} = ($is_ok) ? \&{$s_hash{$_}} : 
+\&{code_highlight};
     50    } else {
     51     $AUBBC{$_} = $s_hash{$_};
     52    }
     53   }
     54   &settings_prep;

Your if block starting at line 44 is superfluous because a foreach list with 0 elements will execute 0 times so you are unnecessarily running keys %s_hash twice.    Line 51 reveals that major purpose of the loop is to copy the keys and values of %s_hash to %AUBBC so I would write that something like:

sub settings {
    ( my $self, %AUBBC ) = ( @_, %AUBBC );

    if ( exists $AUBBC{ highlight_function } ) {
        $AUBBC{ highlight_function } = \&code_highlight unless check_s
+ubroutine( $AUBBC{ highlight_function } );
        $AUBBC{ highlight } = 0;
        }
    settings_prep();

Or if you need the new values in @_ to overwrite the old values in %AUBBC:

sub settings {
    my $self = shift;
    %AUBBC = ( %AUBBC, @_ );

    if ( exists $AUBBC{ highlight_function } ) {
        $AUBBC{ highlight_function } = \&code_highlight unless check_s
+ubroutine( $AUBBC{ highlight_function } );
        $AUBBC{ highlight } = 0;
        }
    settings_prep();

    169  $protect_email = '[' if $AUBBC{protect_email} eq 3 || $AUBBC{
+protect_email} eq 4;
    171   if ($AUBBC{protect_email} eq 1 || $AUBBC{protect_email} eq 2
+) {
    173   } elsif ($AUBBC{protect_email} eq 3) {
    175   } elsif ($AUBBC{protect_email} eq 4) {
    180  if ($AUBBC{protect_email} eq 1) {
    182  } elsif ($AUBBC{protect_email} eq 2) {
    185  } elsif ($AUBBC{protect_email} eq 3 || $AUBBC{protect_email} 
+eq 4) {
    188  return <<JS if $AUBBC{protect_email} eq 2 || $AUBBC{protect_e
+mail} eq 3 || $AUBBC{protect_email} eq 4;
    224   /eg if ($Build_AUBBC{$_}[1] eq 1);
    229   /eg if ($Build_AUBBC{$_}[1] eq 2);
    234   /eg if ($Build_AUBBC{$_}[1] eq 3);
    236   $msg =~ s/\[$_\]/$Build_AUBBC{$_}[2]/g if ($Build_AUBBC{$_}[
+1] eq 4);
    256  if ($NewTag{type} ne 4) {
    260  $NewTag{pattern} = 'l' if ($NewTag{type} eq 3 || $NewTag{type
+} eq 4);
    374   (!$option && $AUBBC{line_break} eq 2)
    376    : $text =~ s/\n/<br$AUBBC{html_type}>\n/go if !$option && $
+AUBBC{line_break} eq 1;

You are using a string operator on a number which means that Perl has to convert the number to a string first before the comparison.    You should either use a numerical comparison operator on numbers (== instead of eq) or use strings when using string comparison operators ($var eq '3').

    222    my $ret = do_sub( $_, $2 , $Build_AUBBC{$_}[2] ) || '';
    223    $ret ? $ret : $1;

    227    my $ret = do_sub( $_, $2 , $Build_AUBBC{$_}[2] ) || '';
    228    $ret ? $ret : $1;

    232    my $ret = do_sub( $_, '' , $Build_AUBBC{$_}[2] ) || '';
    233    $ret ? $ret : $1;

Or simply:

    do_sub( ... ) || $1;

    243  $fun = \&{$fun};

Why are you creating a new reference to an existing code reference?