view release on metacpan or  search on metacpan

lib/Aion/Format/Html.pm  view on Meta::CPAN

# â‹…	умножение точкой = скалярное произведение	⋅	⋅
sdot => 8901,
#
#
# Технические символы
# Символ	Назначение	Мнемоника	Код
#
# ⌈	левая скобка округления вверх = apl upstile	⌈	⌈
lceil => 8968,
# ⌉	правая скобка округления вверх	⌉	⌉
rceil => 8969,
# ⌊	левая скобка округления вниз = apl downstile	⌊	⌊
lfloor => 8970,
# ⌋	правая скобка округления вниз	⌋	⌋
rfloor => 8971,
# ⟨	угловая скобка влево = бра	⟨	〈
lang => 9001,
# ⟩	угловая скобка вправо = кет	⟩	〉
rang => 9002,
#
#
# Геометрические фигуры
# Символ	Назначение	Мнемоника	Код
#
# â—Š	ромб	◊	◊
loz => 9674,
#
#
# Различные символы
# Символ	Назначение	Мнемоника	Код
#
# â™ 	«пики» (карточная масть)	♠	♠
spades => 9824,
# ♣	«трефы» (карточная масть)	♣	♣
clubs => 9827,
# ♥	«червы» (карточная масть)	♥	♥
hearts => 9829,
# ♦	«бубны» (карточная масть)	♦	♦
diams => 9830,
);

sub _set(@) { +{ map { $_ => 1 } @_ } }

# Теги не имеющие закрывающего тега
our %SINGLE_TAG = %{ _set qw/area base br col embed hr img input link meta param source track wbr/ };

# <li> закрывается, если приходит </ol> или </ul>
our %TOP_CLOSE_TAG = (
	li 			=> _set(qw/ol ul/),
	caption 	=> _set(qw/table/),
	thead 		=> _set(qw/table/),
	tbody 		=> _set(qw/table/),
	tfoot 		=> _set(qw/table/),
	tr 			=> _set(qw/table thead tbody tfoot caption/),
	td 			=> _set(qw/table thead tbody tfoot caption/),
	th 			=> _set(qw/table thead tbody tfoot caption/),
	dt			=> _set(qw/dl/),
	dd			=> _set(qw/dl/),
	rt			=> _set(qw/ruby/),
	rp			=> _set(qw/ruby/),
	option 		=> _set(qw/optgroup select/),
	optgroup	=> _set(qw/select/),
);

# <tr> закрывает открытые <td> и <th> и <tr>
our %TOP_NEW_TAG = (
	head		=> _set(qw/body/),
	tr			=> _set(qw/tr thead tbody tfoot/),
	td			=> _set(qw/tr thead tbody tfoot td th/),
	th			=> _set(qw/tr thead tbody tfoot td th/),
	col			=> _set(qw/tr thead tbody tfoot td th colgroup/),
	colgroup	=> _set(qw/thead tbody tfoot caption colgroup/),
	caption		=> _set(qw/thead tbody tfoot caption/),
	thead		=> _set(qw/thead tbody tfoot caption/),
	tbody		=> _set(qw/thead tbody tfoot caption/),
	tfoot		=> _set(qw/thead tbody tfoot caption/),
	li			=> _set(qw/li/),
	dt			=> _set(qw/dt dd/),
	dd			=> _set(qw/dt dd/),
	rt			=> _set(qw/rt rp/),
	rp			=> _set(qw/rt rp/),
	option		=> _set(qw/option optgroup/),
	optgroup	=> _set(qw/optgroup/),
);

# Проверяет, что тег – одиночный
sub is_single_tag(;$) {
	exists $SINGLE_TAG{$_[0] // $_}
}

# Забрасывает тег в стек и возвращает закрытые
sub in_tag(\@$$) {
	my ($S, $tag, $atag) = @_;

	# Выбрасываем из стека предыдущий тег
	my @ret;
	push @ret, pop @$S while @$S and
		($TOP_NEW_TAG{ $S->[$#$S][0] })->{$tag};

	push @$S, [$tag, $atag] unless exists $SINGLE_TAG{$tag};

	@ret
}

# Выбрасывает тег из стека. Возвращает выдавленные им и выбрасывает исключение, если такого в стеке нет
sub out_tag(\@$) {
	my ($S, $tag) = @_;

	# Это одиночный тег - он не может быть закрывающим
	die "</$tag> is a single tag - it cannot be a closing tag" if exists $SINGLE_TAG{$tag};

	# закрываем предыдущий, если нужно
	my @ret;
	push @ret, pop @$S while @$S and
		($TOP_CLOSE_TAG{$S->[$#$S][0]})->{$tag};

	die "</$tag>, but stack is empty!" unless @$S;

	# тег равен закрывающему
	die "<$S->[$#$S][0]> in stack ne </$tag>!" if $S->[$#$S][0] ne $tag;

	push @ret, pop @$S;

lib/Aion/Format/Html.pm  view on Meta::CPAN

	my $ent = sub {
		exists $+{word}? (exists $ENTITIES{$+{word}}? chr $ENTITIES{$+{word}}: $&):
		exists $+{num}? chr $+{num}:
		exists $+{hex}? chr hex $+{hex}: ""
	};
	s{&(
		(?<word>\w+)
		|\#(?<num>\d+)
		|\#x(?<hex>[a-f\d]+)
	);?
	}{$ent->()}genix;

	my $pre;

	my $to = sub {
		my $s1 = $pre? $+{s1}: ($+{s1} eq ""? "": " ");
		
		my $x =
		exists $+{space}? ($pre? $+{space}: " "):
		exists $+{nbsp}? " ":
		exists $+{xhr}? $+{xhr}:
		exists $+{tag}? do {
			my $tag = lc $+{tag};
			$pre = 1 if $tag eq "pre";
			exists $+{close}? $WITH_CLOSE_TAG2SPACE{$tag}: $TAG2SPACE{$tag} 
		}:
		exists $+{ctag}? do {
			my $tag = lc $+{ctag};
			$pre = 0 if $tag eq "pre";
			
			$CLOSE_TAG2SPACE{$tag}
		}:
		"";
		
		my $s2 = $pre? $+{s2}: ($+{s2} eq "" || $s1? "": " ");
		
		$x =~ /\n/ ? $x: join "", $s1, $x, $s2
	};

	s{
		(?<s1> \s*) (
		
			  <(script|style|template)\b [^<>]*> .*? </ \g1 \s* >
			| <xhr \b [^<>]*> (?<xhr> .*? ) </xhr \s* >
			| < (?<tag> [a-z]\w* ) [^<>]*? (?<close> / )? \s*>
			| </ (?<ctag> [a-z]\w* ) \s*>
			| <!--.*?-->
		
		) (?<s2> \s*)
		| (?<space> [\ \t\n\r\f]+)
		| (?<nbsp> \xa0)
	}{$to->()}genisx;

	$_
}

# Все, кроме запрещённых:
#  applet, script, style, embed, object, param,
#  video, audio, source, track, frame, frameset, iframe, comment
#  html, head, body, title, meta, base, basefont, bgsound, link
#  form, keygen, output, textarea, select, option, optgroup, legend, label, input
#  plaintext, xmp
# А так же удаляет атрибуты начинающиеся на "on", name, for, formaction и др..
my %SAFE_TAG = map {$_=>1} qw/
a
abbr
acronym
address

area
article
aside

b
bdi
bdo

blockquote
big

blink
br
button

canvas
caption
center
cite
code
col
colgroup
command

datalist
dd
del
details
dfn
dir
div
dl
dt

em

figcaption
figure
font
footer

h1
h2
h3
h4
h5
h6
header
hgroup
hr

i