1#@!#!123s

: / usr / lib / sonarpush / SonarPush /
Filename : Util.pm
back
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;