git.maemo.org Git - dh-make-perl/blob - dev/arm/libhtml-parser-perl/libhtml-parser-perl-3.56/t/parsefile.t

   1 use Test::More tests => 6;
   2
   3 my $filename = "file$$.htm";
   4 die "$filename is already there" if -e $filename;
   5 open(FILE, ">$filename") || die "Can't create $filename: $!";
   6 print FILE <<'EOT'; close(FILE);
   7 <title>Heisan</title>
   8 EOT
   9
  10 {
  11     package MyParser;
  12     require HTML::Parser;
  13     @ISA=qw(HTML::Parser);
  14
  15     sub start
  16     {
  17         my($self, $tag, $attr) = @_;
  18         Test::More::is($tag, "title");
  19     }
  20 }
  21
  22 MyParser->new->parse_file($filename);
  23 open(FILE, $filename) || die;
  24 MyParser->new->parse_file(*FILE);
  25 seek(FILE, 0, 0) || die;
  26 MyParser->new->parse_file(\*FILE);
  27 close(FILE);
  28
  29 require IO::File;
  30 my $io = IO::File->new($filename) || die;
  31 MyParser->new->parse_file($io);
  32 $io->seek(0, 0) || die;
  33 MyParser->new->parse_file(*$io);
  34
  35 my $text = '';
  36 $io->seek(0, 0) || die;
  37 MyParser->new(
  38     start_h => [ sub{ shift->eof; }, "self" ],
  39     text_h =>  [ sub{ $text = shift; }, "text" ])->parse_file(*$io);
  40 ok(!$text);
  41
  42 close($io);  # needed because of bug in perl
  43 undef($io);
  44
  45 unlink($filename) or warn "Can't unlink $filename: $!";