inc/HTML/TokeParser.pm

#line 1
package HTML::TokeParser;

# $Id: TokeParser.pm,v 2.35 2005/12/02 16:08:17 gisle Exp $

require HTML::PullParser;
@ISA=qw(HTML::PullParser);
$VERSION = sprintf("%d.%02d", q$Revision: 2.35 $ =~ /(\d+)\.(\d+)/);

use strict;
use Carp ();
use HTML::Entities qw(decode_entities);
use HTML::Tagset ();

my %ARGS =
(
 start       => "'S',tagname,attr,attrseq,text",
 end         => "'E',tagname,text",
 text        => "'T',text,is_cdata",
 process     => "'PI',token0,text",
 comment     => "'C',text",
 declaration => "'D',text",

 # options that default on
 unbroken_text => 1,
);


sub new
{
    my $class = shift;
    my %cnf;
    if (@_ == 1) {
        my $type = (ref($_[0]) eq "SCALAR") ? "doc" : "file";
        %cnf = ($type => $_[0]);
    }
    else {
        %cnf = @_;
    }

    my $textify = delete $cnf{textify} || {img => "alt", applet => "alt"};

    my $self = $class->SUPER::new(%cnf, %ARGS) || return undef;

    $self->{textify} = $textify;
    $self;
}


sub get_tag
{
    my $self = shift;
    my $token;
    while (1) {
        $token = $self->get_token || return undef;
        my $type = shift @$token;
        next unless $type eq "S" || $type eq "E";
        substr($token->[0], 0, 0) = "/" if $type eq "E";
        return $token unless @_;
        for (@_) {
            return $token if $token->[0] eq $_;
        }
    }
}


sub _textify {
    my($self, $token) = @_;
    my $tag = $token->[1];
    return undef unless exists $self->{textify}{$tag};

    my $alt = $self->{textify}{$tag};
    my $text;
    if (ref($alt)) {
        $text = &$alt(@$token);
    } else {
        $text = $token->[2]{$alt || "alt"};
        $text = "[\U$tag]" unless defined $text;
    }
    return $text;
}


sub get_text
{
    my $self = shift;
    my @text;
    while (my $token = $self->get_token) {
        my $type = $token->[0];
        if ($type eq "T") {
            my $text = $token->[1];
            decode_entities($text) unless $token->[2];
            push(@text, $text);
        } elsif ($type =~ /^[SE]$/) {
            my $tag = $token->[1];
            if ($type eq "S") {
                if (defined(my $text = _textify($self, $token))) {
                    push(@text, $text);
                    next;
                }
            } else {
                $tag = "/$tag";
            }
            if (!@_ || grep $_ eq $tag, @_) {
                 $self->unget_token($token);
                 last;
            }
            push(@text, " ")
                if $tag eq "br" || !$HTML::Tagset::isPhraseMarkup{$token->[1]};
        }
    }
    join("", @text);
}


sub get_trimmed_text
{
    my $self = shift;
    my $text = $self->get_text(@_);
    $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
    $text;
}

sub get_phrase {
    my $self = shift;
    my @text;
    while (my $token = $self->get_token) {
        my $type = $token->[0];
        if ($type eq "T") {
            my $text = $token->[1];
            decode_entities($text) unless $token->[2];
            push(@text, $text);
        } elsif ($type =~ /^[SE]$/) {
            my $tag = $token->[1];
            if ($type eq "S") {
                if (defined(my $text = _textify($self, $token))) {
                    push(@text, $text);
                    next;
                }
            }
            if (!$HTML::Tagset::isPhraseMarkup{$tag}) {
                $self->unget_token($token);
                last;
            }
            push(@text, " ") if $tag eq "br";
        }
    }
    my $text = join("", @text);
    $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
    $text;
}

1;


__END__

#line 367
1	#line 1
2	package HTML::TokeParser;
3
4	# $Id: TokeParser.pm,v 2.35 2005/12/02 16:08:17 gisle Exp $
5
6	require HTML::PullParser;
7	@ISA=qw(HTML::PullParser);
8	$VERSION = sprintf("%d.%02d", q$Revision: 2.35 $ =~ /(\d+)\.(\d+)/);
9
10	use strict;
11	use Carp ();
12	use HTML::Entities qw(decode_entities);
13	use HTML::Tagset ();
14
15	my %ARGS =
16	(
17	start => "'S',tagname,attr,attrseq,text",
18	end => "'E',tagname,text",
19	text => "'T',text,is_cdata",
20	process => "'PI',token0,text",
21	comment => "'C',text",
22	declaration => "'D',text",
23
24	# options that default on
25	unbroken_text => 1,
26	);
27
28
29	sub new
30	{
31	my $class = shift;
32	my %cnf;
33	if (@_ == 1) {
34	my $type = (ref($_[0]) eq "SCALAR") ? "doc" : "file";
35	%cnf = ($type => $_[0]);
36	}
37	else {
38	%cnf = @_;
39	}
40
41	my $textify = delete $cnf{textify} \|\| {img => "alt", applet => "alt"};
42
43	my $self = $class->SUPER::new(%cnf, %ARGS) \|\| return undef;
44
45	$self->{textify} = $textify;
46	$self;
47	}
48
49
50	sub get_tag
51	{
52	my $self = shift;
53	my $token;
54	while (1) {
55	$token = $self->get_token \|\| return undef;
56	my $type = shift @$token;
57	next unless $type eq "S" \|\| $type eq "E";
58	substr($token->[0], 0, 0) = "/" if $type eq "E";
59	return $token unless @_;
60	for (@_) {
61	return $token if $token->[0] eq $_;
62	}
63	}
64	}
65
66
67	sub _textify {
68	my($self, $token) = @_;
69	my $tag = $token->[1];
70	return undef unless exists $self->{textify}{$tag};
71
72	my $alt = $self->{textify}{$tag};
73	my $text;
74	if (ref($alt)) {
75	$text = &$alt(@$token);
76	} else {
77	$text = $token->[2]{$alt \|\| "alt"};
78	$text = "[\U$tag]" unless defined $text;
79	}
80	return $text;
81	}
82
83
84	sub get_text
85	{
86	my $self = shift;
87	my @text;
88	while (my $token = $self->get_token) {
89	my $type = $token->[0];
90	if ($type eq "T") {
91	my $text = $token->[1];
92	decode_entities($text) unless $token->[2];
93	push(@text, $text);
94	} elsif ($type =~ /^[SE]$/) {
95	my $tag = $token->[1];
96	if ($type eq "S") {
97	if (defined(my $text = _textify($self, $token))) {
98	push(@text, $text);
99	next;
100	}
101	} else {
102	$tag = "/$tag";
103	}
104	if (!@_ \|\| grep $_ eq $tag, @_) {
105	$self->unget_token($token);
106	last;
107	}
108	push(@text, " ")
109	if $tag eq "br" \|\| !$HTML::Tagset::isPhraseMarkup{$token->[1]};
110	}
111	}
112	join("", @text);
113	}
114
115
116	sub get_trimmed_text
117	{
118	my $self = shift;
119	my $text = $self->get_text(@_);
120	$text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
121	$text;
122	}
123
124	sub get_phrase {
125	my $self = shift;
126	my @text;
127	while (my $token = $self->get_token) {
128	my $type = $token->[0];
129	if ($type eq "T") {
130	my $text = $token->[1];
131	decode_entities($text) unless $token->[2];
132	push(@text, $text);
133	} elsif ($type =~ /^[SE]$/) {
134	my $tag = $token->[1];
135	if ($type eq "S") {
136	if (defined(my $text = _textify($self, $token))) {
137	push(@text, $text);
138	next;
139	}
140	}
141	if (!$HTML::Tagset::isPhraseMarkup{$tag}) {
142	$self->unget_token($token);
143	last;
144	}
145	push(@text, " ") if $tag eq "br";
146	}
147	}
148	my $text = join("", @text);
149	$text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
150	$text;
151	}
152
153	1;
154
155
156	__END__
157
158	#line 367