summaryrefslogtreecommitdiff
path: root/t/parsefile.t
blob: f373f066f6b4362e5d83a276fa731594644867c4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
use Test::More tests => 6;

my $filename = "file$$.htm";
die "$filename is already there" if -e $filename;
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
<title>Heisan</title>
EOT

{
    package MyParser;
    require HTML::Parser;
    @ISA=qw(HTML::Parser);

    sub start
    {
	my($self, $tag, $attr) = @_;
	Test::More::is($tag, "title");
    }
}

MyParser->new->parse_file($filename);
open(FILE, $filename) || die;
MyParser->new->parse_file(*FILE);
seek(FILE, 0, 0) || die;
MyParser->new->parse_file(\*FILE);
close(FILE);

require IO::File;
my $io = IO::File->new($filename) || die;
MyParser->new->parse_file($io);
$io->seek(0, 0) || die;
MyParser->new->parse_file(*$io);

my $text = '';
$io->seek(0, 0) || die;
MyParser->new(
    start_h => [ sub{ shift->eof; }, "self" ],
    text_h =>  [ sub{ $text = shift; }, "text" ])->parse_file(*$io);
ok(!$text);

close($io);  # needed because of bug in perl
undef($io);

unlink($filename) or warn "Can't unlink $filename: $!";