????
Your IP : 216.73.216.174
package SonarPush::Util;
use strict;
use warnings;
use vars qw(%entity2char %char2entity);
=head1 NAME
SonarPush::Util - Commonly used utility functions
=head1 SYNOPSIS
use SonarPush::Util;
# Encode or decode strings with HTML entities
SonarPush::Util->encode_entities();
=head1 DESCRIPTION
Module for various miscellaneous but frequently used utility functions.
=head1 SUBROUTINES/METHODS
See descriptions below.
=cut
%entity2char = (
# Some normal chars that have special meaning in SGML context
amp => '&', # ampersand
'gt' => '>', # greater than
'lt' => '<', # less than
quot => '"', # double quote
apos => "'", # single quote
);
# Make the opposite mapping
while (my ($entity, $char) = each(%entity2char)) {
$entity =~ s/;\z//;
$char2entity{$char} = "&$entity;";
}
delete $char2entity{"'"}; # only one-way decoding
my %subst;
sub num_entity {
sprintf "&#x%X;", ord($_[0]);
}
sub encode_entities {
return undef unless defined $_[0];
my $ref;
if (defined wantarray) {
my $x = $_[0];
$ref = \$x; # copy
} else {
$ref = \$_[0]; # modify in-place
}
if (defined $_[1] and length $_[1]) {
unless (exists $subst{ $_[1] }) {
# Because we can't compile regex we fake it with a cached sub
my $chars = $_[1];
$chars =~ s,(?<!\\)([]/]),\\$1,g;
$chars =~ s,(?<!\\)\\\z,\\\\,;
my $code = "sub {\$_[0] =~ s/([$chars])/\$char2entity{\$1} || num_entity(\$1)/ge; }";
$subst{ $_[1] } = eval $code;
die($@ . " while trying to turn range: \"$_[1]\"\n "
. "into code: $code\n "
) if $@;
}
&{ $subst{ $_[1] } }($$ref);
} else {
# Encode control chars, high bit chars and '<', '&', '>', ''' and '"'
$$ref =~ s/([^\n\r\t !\#\$%\(-;=?-~])/$char2entity{$1} || num_entity($1)/ge;
}
$$ref;
}
1;