File Coverage

blib/lib/HTML/Parser.pm
Criterion Covered Total %
statement 53 55 96.3
branch 18 22 81.8
condition 5 6 83.3
subroutine 8 8 100.0
pod 3 5 60.0
total 87 96 90.6


line stmt bran cond sub pod time code
1             package HTML::Parser;
2              
3 49     49   103349 use strict;
  49         306  
  49         43433  
4              
5             our $VERSION = '3.81';
6              
7             require HTML::Entities;
8              
9             require XSLoader;
10             XSLoader::load('HTML::Parser', $VERSION);
11              
12             sub new
13             {
14 129     129 1 964155 my $class = shift;
15 129         377 my $self = bless {}, $class;
16 129         434 return $self->init(@_);
17             }
18              
19              
20             sub init
21             {
22 129     129 0 279 my $self = shift;
23 129         1146 $self->_alloc_pstate;
24              
25 129         400 my %arg = @_;
26 129   66     658 my $api_version = delete $arg{api_version} || (@_ ? 3 : 2);
27 129 100       378 if ($api_version >= 4) {
28 1         6 require Carp;
29 1         211 Carp::croak("API version $api_version not supported " .
30             "by HTML::Parser $VERSION");
31             }
32              
33 128 100       348 if ($api_version < 3) {
34             # Set up method callbacks compatible with HTML-Parser-2.xx
35 47         452 $self->handler(text => "text", "self,text,is_cdata");
36 47         214 $self->handler(end => "end", "self,tagname,text");
37 47         206 $self->handler(process => "process", "self,token0,text");
38 47         246 $self->handler(start => "start",
39             "self,tagname,attr,attrseq,text");
40              
41             $self->handler(comment =>
42             sub {
43 53     53   5044 my($self, $tokens) = @_;
44 53         132 for (@$tokens) {
45 55         121 $self->comment($_);
46             }
47 47         327 }, "self,tokens");
48              
49             $self->handler(declaration =>
50             sub {
51 10     10   369 my $self = shift;
52 10         43 $self->declaration(substr($_[0], 2, -1));
53 47         225 }, "self,text");
54             }
55              
56 128 100       391 if (my $h = delete $arg{handlers}) {
57 3 50       15 $h = {@$h} if ref($h) eq "ARRAY";
58 3         20 while (my($event, $cb) = each %$h) {
59 3         54 $self->handler($event => @$cb);
60             }
61             }
62              
63             # In the end we try to assume plain attribute or handler
64 128         629 while (my($option, $val) = each %arg) {
65 101 100       591 if ($option =~ /^(\w+)_h$/) {
    50          
66 57         882 $self->handler($1 => @$val);
67             }
68             elsif ($option =~ /^(text|start|end|process|declaration|comment)$/) {
69 0         0 require Carp;
70 0         0 Carp::croak("Bad constructor option '$option'");
71             }
72             else {
73 44         387 $self->$option($val);
74             }
75             }
76              
77 128         666 return $self;
78             }
79              
80              
81             sub parse_file
82             {
83 18     18 1 42686 my($self, $file) = @_;
84 18         33 my $opened;
85 18 100 100     106 if (!ref($file) && ref(\$file) ne "GLOB") {
86             # Assume $file is a filename
87 10         35 local(*F);
88 10 50       411 open(F, "<", $file) || return undef;
89 10         49 binmode(F); # should we? good for byte counts
90 10         41 $opened++;
91 10         62 $file = *F;
92             }
93 18         41 my $chunk = '';
94 18         372 while (read($file, $chunk, 512)) {
95 3960 100       32475 $self->parse($chunk) || last;
96             }
97 18 100       278 close($file) if $opened;
98 18         154 $self->eof;
99             }
100              
101              
102             sub netscape_buggy_comment # legacy
103             {
104 1     1 0 2912 my $self = shift;
105 1         6 require Carp;
106 1         200 Carp::carp("netscape_buggy_comment() is deprecated. " .
107             "Please use the strict_comment() method instead");
108 1         59 my $old = !$self->strict_comment;
109 1 50       34 $self->strict_comment(!shift) if @_;
110 1         10 return $old;
111             }
112              
113             # set up method stubs
114       12557 1   sub text { }
115             *start = \&text;
116             *end = \&text;
117             *comment = \&text;
118             *declaration = \&text;
119             *process = \&text;
120              
121             1;
122              
123             __END__