home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / doc / libhtml-parser-perl / examples / hform < prev    next >
Encoding:
Text File  |  2006-06-19  |  1.8 KB  |  84 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # See also HTML::Form module
  4.  
  5. use HTML::PullParser ();
  6. use HTML::Entities qw(decode_entities);
  7. use Data::Dumper qw(Dumper);
  8.  
  9. my @FORM_TAGS = qw(form input textarea button select option);
  10.  
  11. my $p = HTML::PullParser->new(file => shift || "xxx.html",
  12.                   start => 'tag, attr',
  13.                   end   => 'tag',
  14.                   text  => '@{text}',
  15.                   report_tags => \@FORM_TAGS,
  16.                  ) || die "$!";
  17.  
  18. # a little helper function
  19. sub get_text {
  20.     my($p, $stop) = @_;
  21.     my $text;
  22.     while (defined(my $t = $p->get_token)) {
  23.     if (ref $t) {
  24.         $p->unget_token($t) unless $t->[0] eq $stop;
  25.         last;
  26.     }
  27.     else {
  28.         $text .= $t;
  29.     }
  30.     }
  31.     return $text;
  32. }
  33.  
  34. my @forms;
  35. while (defined(my $t = $p->get_token)) {
  36.     next unless ref $t; # skip text
  37.     if ($t->[0] eq "form") {
  38.     shift @$t;
  39.     push(@forms, $t);
  40.     while (defined(my $t = $p->get_token)) {
  41.         next unless ref $t;  # skip text
  42.         last if $t->[0] eq "/form";
  43.         if ($t->[0] eq "select") {
  44.         my $sel = $t;
  45.         push(@{$forms[-1]}, $t);
  46.         while (defined(my $t = $p->get_token)) {
  47.             next unless ref $t; # skip text
  48.             last if $t->[0] eq "/select";
  49.             #print "select ", Dumper($t), "\n";
  50.             if ($t->[0] eq "option") {
  51.             my $value = $t->[1]->{value};
  52.             my $text = get_text($p, "/option");
  53.             unless (defined $value) {
  54.                 $value = decode_entities($text);
  55.             }
  56.             push(@$sel, $value);
  57.             }
  58.             else {
  59.             warn "$t->[0] inside select";
  60.             }
  61.         }
  62.         }
  63.         elsif ($t->[0] =~ /^\/?option$/) {
  64.         warn "option tag outside select";
  65.         }
  66.         elsif ($t->[0] eq "textarea") {
  67.         push(@{$forms[-1]}, $t);
  68.         $t->[1]{value} = get_text($p, "/textarea");
  69.         }
  70.         elsif ($t->[0] =~ m,^/,) {
  71.         warn "stray $t->[0] tag";
  72.         }
  73.         else {
  74.         push(@{$forms[-1]}, $t);
  75.         }
  76.     }
  77.     }
  78.     else {
  79.     warn "form tag $t->[0] outside form";
  80.     }
  81. }
  82.  
  83. print Dumper(\@forms), "\n";
  84.