Tripletail

 view release on metacpan or  search on metacpan

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

use Tripletail;
use DynaLoader;
use base 'DynaLoader';
our @XSUBS = qw(next _next_elem Element::parse Element::attr);
our $XS_LOADERROR;
Tripletail::HtmlFilter->my_bootstrap($Tripletail::XS_VERSION);

use constant {
	# 注意: ここを変更した時は XS 側も修正する事。
	INTEREST       => 0,
	TRACK          => 1,
	FILTER_TEXT    => 2,
	FILTER_COMMENT => 3,
	CONTEXT        => 4,
	HTML           => 5,
	OUTPUT         => 6,
};
my %_MATCHER_CACHE;

sub my_bootstrap
{
  my $pkg = shift;
  
  if( !$PURE_PERL )
  {
    local ($@);
    eval
    {
      local($SIG{__DIE__}) = 'DEFAULT';
      $pkg->SUPER::bootstrap(@_);
    };
    $XS_LOADERROR = $@;
  }else
  {
    $XS_LOADERROR = 'disabled';
  }
  
  do
  {
    no strict 'refs';
    #$err and chomp $err;
    #warn "warning: $err";
    foreach my $name (@XSUBS)
    {
      my $xsub = __PACKAGE__.'::'.$name;
      if( !defined(&$xsub) )
      {
        (my $ppsub = $xsub) =~ s/(\w+)$/_$1_pp/;
        *$xsub = \&$ppsub;
      }
    }
  }
}

1;

sub _new {
    my $class = shift;
    my $opts = { @_ };

	my $this = bless [] => $class;

	$this->[INTEREST]       = $opts->{interest};
	$this->[TRACK]          = $opts->{track};
	$this->[FILTER_TEXT]    = $opts->{filter_text};
	$this->[FILTER_COMMENT] = $opts->{filter_comment};
	
    $this->[CONTEXT]        = Tripletail::HtmlFilter::Context->_new;
    $this->[HTML]           = undef; # 文字列
    $this->[OUTPUT]         = []; # Tripletail::HtmlFilter::{Element,Text,Comment}

    # interest, trackに渡された正規表現はこの時点で CODE にコンパイルしておく。
    if ($this->[INTEREST]) {
		$this->[INTEREST] = $this->_compile_matcher($this->[INTEREST]);
    }

    if ($this->[TRACK]) {
		$this->[TRACK] = $this->_compile_matcher($this->[TRACK]);
    }

    $this;
}

sub set {
    my $this = shift;
    my $html = shift;

    if (not defined $html) {
		die __PACKAGE__."#set: ARG[1] is not defined.\n";
    }
    elsif (ref $html) {
		die __PACKAGE__."#set: ARG[1] is a Ref.\n";
    }

    #@{$this->[HTML]} = split m/(<.+?>)/s, $html;
    # ↑では、<!-- <hoge> -->を正しく解析できない。真面目にパーズする必要がある
    # しかし、perlで真面目にパーザを書くのは非常に面倒なので正規表現で誤魔化す
    # NB: 他にも、正しく解析できないパターンが存在するかも
    @{$this->[HTML]} = split m/((?:<!--.*?-->)|(?:<.+?>))/s, $html;
    @{$this->[OUTPUT]} = ();
    $this;
}

sub toStr {
    my $this = shift;

    $this->[CONTEXT]->_flush($this); # 未確定の部分を確定する

    join('', map {ref($_)?$_->toStr:$_} @{$this->[OUTPUT]});
}

sub _compile_matcher {
	my $this = shift;
	my $regexes = shift;

	my $joined = join('', @$regexes);
	if (my $cached = $_MATCHER_CACHE{$joined}) {
		return $cached;
	}

	my $ret = [];

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

				if ($m->($str)) {
					return 1;
				}
			}
			else {
				if ($m eq $str) {
					return 1;
				}
			}
		}

		undef;
	};

	my ($interested,$parsed);
	if (defined $elem_name) {
		my ($close,$nameonly) = $elem_name =~ /^(\/?)(.*)/;
		
		if ($this->[TRACK] and $is_matched->($this->[TRACK], $nameonly)) {
			$parsed = $elem;
			if ($close) {
				$this->[CONTEXT]->removein($nameonly);
			}
			else {
				$this->[CONTEXT]->addin($nameonly => $parsed);
			}
		}
    
		if ($this->[INTEREST] and $is_matched->($this->[INTEREST], $elem_name)) {
			$interested = $elem;
		}
	}
	($interested,$parsed);
}

sub _output {
    my $this = shift;
    my $elem = shift;
    # 渡されたオブジェクト(若しくはテキスト)を
    # $this->[OUTPUT] に追加しているだけ. 
    # 直接pushしているコードもあるので修正する際には注意. 
    push @{$this->[OUTPUT]}, $elem;
    $this;
}


# =============================================================================
# Tripletail::HtmlFilter::Context.
#
package Tripletail::HtmlFilter::Context;
use constant {
	IN      => 0,
	ADDED   => 1,
	DELETED => 2,
	CURRENT => 3,
};

sub _new {
    my $class = shift;

    my $this = bless [] => $class;
    $this->[IN] = [];
    $this->[ADDED] = [];
    $this->[DELETED] = undef;
    $this->[CURRENT] = undef; # Tripletail::HtmlFilter::{Element,Comment,Text}

    $this;
}

sub newElement {
    my $this = shift;
    my $name = shift;

    Tripletail::HtmlFilter::Element->_new($name);
}

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

    Tripletail::HtmlFilter::Text->_new($str);
}

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

    Tripletail::HtmlFilter::Comment->_new($str);
}

sub addin {
    my $this = shift;
    my $name = lc shift;
    my $elem = shift;

    unshift(@{$this->[IN]}, [$name, $elem]);
    
    $this;
}

sub removein {
    my $this = shift;
    my $name = lc shift;

    while(my $elem = shift(@{$this->[IN]})) {
		last if($elem->[0] eq $name);
    }
    
    $this;
}

sub in {
    my $this = shift;
    my $name = lc shift;

    foreach my $elem (@{$this->[IN]}) {
		if($elem->[0] eq $name) {
			return $elem->[1];
		}
    }

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

		return $this; # 何もする必要が無い
    }

    if ($this->[DELETED]) {
		# 削除するように指示された。
		$this->[DELETED] = undef;
    }
    else {
		$filter->_output($this->[CURRENT]);
    }

    foreach (@{$this->[ADDED]}) {
		$filter->_output($_);
    }
    @{$this->[ADDED]} = ();

    $this->[CURRENT] = undef;
    $this;
}

# =============================================================================
# Tripletail::HtmlFilter::ElementBase.
#
package Tripletail::HtmlFilter::ElementBase;
sub isElement {
    my $this = shift;
    (ref $this) eq 'Tripletail::HtmlFilter::Element';
}

sub isText {
    my $this = shift;
    (ref $this) eq 'Tripletail::HtmlFilter::Text';
}

sub isComment {
    my $this = shift;
    (ref $this) eq 'Tripletail::HtmlFilter::Comment';
}

# =============================================================================
# Tripletail::HtmlFilter::Element.
#
package Tripletail::HtmlFilter::Element;
use constant {
	# 注意: ここを変更した時は XS 側も修正する事。
	NAME   => 0,
	ATTRS  => 1,
	ATTR_H => 2,
	TAIL   => 3,
};
our @ISA = qw(Tripletail::HtmlFilter::ElementBase);

sub _new {
    my $class = shift;
    my $name = shift; # undef可

    if (ref $name) {
		die __PACKAGE__."#_new, ARG[1] was bad Ref. [$name]\n";
    }

    my $this = bless [] => $class;
    $this->[NAME] = $name;
    $this->[ATTRS] = []; # [[key, val], [key, val], ...]
    $this->[ATTR_H] = {}; # key => [key, val] ($this->[ATTRS]の要素と共有)
    $this->[TAIL] = undef;

    $this;
}

sub name {
	# 注意: このメソッドは XS 側では使用されない。
    my $this = shift;
    if (@_) {
		$this->[NAME] = shift;

		if (ref $this->[NAME]) {
			die __PACKAGE__."#name: ARG[1] is a Ref. [".$this->[NAME]."]\n";
		}
    }
    $this->[NAME];
}

sub _parse_pp {
    my $this = shift;
    local($_) = shift;

    if (ref) {
		die __PACKAGE__."#parse: ARG[1] is a Ref. [$_]\n";
    }

    s/^<//;

    (s/^\s*(\/?\w+)//) and ($this->[NAME] = $1);

    while(1) {
        (s/([\w:\-]+)\s*=\s*"([^"]*)"//)     ? ($this->attr($1 => $2)) :
          (s/([\w:\-]+)\s*=\s*'([^']*)'//)   ? ($this->attr($1 => $2)) :
            (s/([\w:\-]+)\s*=\s*([^\s>]+)//) ? ($this->attr($1 => $2)) :
              (s~(\w+|/)~~)                  ? ($this->end($1)) :
                last;
    }

    $this;
}

sub _attr_pp {
    my $this = shift;
    my $key = shift;

    if (not defined $key) {
		die __PACKAGE__."#attr: ARG[1] is not defined.\n";
    }
    elsif (ref $key) {
		die __PACKAGE__."#attr: ARG[1] is a Ref. [$key]\n";
    }
    
    if (@_) {
		my $val = shift;

		if (ref $val) {
			die __PACKAGE__."#attr: ARG[2] is a Ref. [$val]\n";

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

			undef; # 存在しない
		}
    }
}

sub attrList {
    my $this = shift;

    map { $_->[0] } @{$this->[ATTRS]}
}

sub tail {
	goto &end;
}

sub end {
	# 注意: このメソッドは XS 側では使用されない。
    my $this = shift;
    if (@_) {
		$this->[TAIL] = shift;

		if (ref $this->[TAIL]) {
			die __PACKAGE__."#end: ARG[1] is a Ref. [$this->[TAIL]]\n";
		}
    }
    $this->[TAIL];
}

sub toStr {
    my $this = shift;
    my $str = '<' . $this->[NAME];

    foreach my $attr (@{$this->[ATTRS]}) {
        my $key   = $attr->[0];
        my $value = $attr->[1];
        $value =~ s/"/&quot;/g;
        $str .= sprintf(qq{ %s="%s"}, $key, $value);
    }

    if( defined $this->[TAIL] and length $this->[TAIL] )
	{
		$str .= ' ' . $this->[TAIL];
    }

    $str .= '>';
}

# =============================================================================
# Tripletail::HtmlFilter::Text.
#
package Tripletail::HtmlFilter::Text;
use constant {
	STR => 0,
};
our @ISA = qw(Tripletail::HtmlFilter::ElementBase);

sub _new {
    my $class = shift;
    my $str = shift;

    my $this = bless [] => $class;
    $this->[STR] = $str;

    $this;
}

sub str {
    my $this = shift;
    if (@_) {
		$this->[STR] = shift;

		if (ref $this->[STR]) {
			die ref($this)."#str: ARG[1] is a Ref. [".$this->[STR]."]\n";
		}
    }
    $this->[STR];
}

sub toStr {
    my $this = shift;
    $this->[STR];
}

# =============================================================================
# Tripletail::HtmlFilter::Comment.
#
package Tripletail::HtmlFilter::Comment;
our @ISA = qw(Tripletail::HtmlFilter::Text);
use constant {
	STR => Tripletail::HtmlFilter::Text::STR(),
};


sub toStr {
    my $this = shift;
    sprintf '<!-- %s -->', $this->[STR];
}


__END__

=encoding utf-8

=head1 NAME

Tripletail::HtmlFilter - HTMLのパースと書き換え

=head1 SYNOPSIS

  my $filter = $TL->newHtmlFilter(
      interest => ['form', 'textarea'],
  );
  $filter->set($html);
  
  while (my ($context, $elem) = $filter->next) {
      ...
  }

  print $filter->toStr;

=head1 DESCRIPTION