view release on metacpan or  search on metacpan

lib/Tripletail/TagCheck.pm  view on Meta::CPAN

sub __close {
	my $this = shift;
	my $name = shift;
	my $stack = shift;

	for(my $i = @$stack-1; $i >= 0; $i--) {
		if(lc($stack->[$i]->name) eq $name) {
			splice @$stack, $i, 1;
			last;
		}
	}
}

sub __break {
	my $this = shift;
	my $types = shift;
	my $stack = shift;
	my $result = '';

	for(my $i = @$stack-1; $i >= 0; $i--) {
		my $taginfo = $this->{allowed}{lc($stack->[$i]->name)};
		my $tagbreak = $taginfo ? $taginfo->tagbreak : undef;
		if(!$tagbreak) {
			$tagbreak = $this->{tagbreak};
		}

		if(grep {$_ eq $tagbreak} @$types) {
			# 実際に閉じる
			$result = sprintf '%s</%s>', $result, $stack->[$i]->name;
			splice @$stack, $i, 1;
		}
	}

	$result;
}

sub __autoLink {
	my $this = shift;
	my $str = shift;

	$str =~ s{((?:https?|ftp|mailto)://[\x21-\x7e]+)}{
		if(defined(my $target = $this->{target})) {
			sprintf '<a href="%s" target="%s">%s</a>',
				$TL->escapeTag($1),
				$target,
				$TL->escapeTag($1);
		} else {
			sprintf '<a href="%s">%s</a>',
				$TL->escapeTag($1),
				$TL->escapeTag($1);
		}
	}eg;

	$str;
}

package Tripletail::TagCheck::TagInfo;
sub new {
	my $class = shift;
	my $tag = shift;
	my $this = bless {} => $class;

	$this->{tag} = $tag;
	$this->{must_be_empty} = undef;
	$this->{allowed_attributes} = undef; # 属性名 => 1
	$this->{allowed_children} = undef; # 要素名 => 1
	$this->{is_text_allowed} = 1;
	$this->{tagbreak} = undef; # undefでなければtag breakをオーバーライド

	$this;
}

sub mustBeEmpty {
	my $this = shift;

	if(@_) {
		$this->{must_be_empty} = shift;
	}

	$this->{must_be_empty};
}

sub setAllowedAttributes {
	my $this = shift;

	$this->{allowed_attributes} = { map {$_ => 1} @_ };

	$this;
}

sub isAllowedAttribute {
	my $this = shift;
	my $attr = shift;

	my $allow_attr = $this->{allowed_attributes};
	if($allow_attr) {
		$allow_attr->{$attr};
	} else {
		1;
	}
}

sub setAllowedChildren {
	my $this = shift;

	$this->{allowed_children} = { map {$_ => 1} @_ };

	if($this->{allowed_children}{'*'}) {
		$this->{is_text_allowed} = 1;
		delete $this->{allowed_children};
	}

	$this;
}

sub isAllowedChild {
	my $this = shift;
	my $elem = shift;

	my $child = $this->{allowed_children};
	if($child) {