Add ARM files

[dh-make-perl] / dev / arm / libhtml-parser-perl / libhtml-parser-perl-3.56 / debian / libhtml-parser-perl / usr / share / doc / libhtml-parser-perl / examples / hform

diff --git a/dev/arm/libhtml-parser-perl/libhtml-parser-perl-3.56/debian/libhtml-parser-perl/usr/share/doc/libhtml-parser-perl/examples/hform b/dev/arm/libhtml-parser-perl/libhtml-parser-perl-3.56/debian/libhtml-parser-perl/usr/share/doc/libhtml-parser-perl/examples/hform
new file mode 100755 (executable)
index 0000000..ea2a2a1
--- /dev/null
+++ b/dev/arm/libhtml-parser-perl/libhtml-parser-perl-3.56/debian/libhtml-parser-perl/usr/share/doc/libhtml-parser-perl/examples/hform
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -w
+
+# See also HTML::Form module
+
+use HTML::PullParser ();
+use HTML::Entities qw(decode_entities);
+use Data::Dumper qw(Dumper);
+
+my @FORM_TAGS = qw(form input textarea button select option);
+
+my $p = HTML::PullParser->new(file => shift || "xxx.html",
+                             start => 'tag, attr',
+                             end   => 'tag',
+                             text  => '@{text}',
+                             report_tags => \@FORM_TAGS,
+                            ) || die "$!";
+
+# a little helper function
+sub get_text {
+    my($p, $stop) = @_;
+    my $text;
+    while (defined(my $t = $p->get_token)) {
+       if (ref $t) {
+           $p->unget_token($t) unless $t->[0] eq $stop;
+           last;
+       }
+       else {
+           $text .= $t;
+       }
+    }
+    return $text;
+}
+
+my @forms;
+while (defined(my $t = $p->get_token)) {
+    next unless ref $t; # skip text
+    if ($t->[0] eq "form") {
+       shift @$t;
+       push(@forms, $t);
+       while (defined(my $t = $p->get_token)) {
+           next unless ref $t;  # skip text
+           last if $t->[0] eq "/form";
+           if ($t->[0] eq "select") {
+               my $sel = $t;
+               push(@{$forms[-1]}, $t);
+               while (defined(my $t = $p->get_token)) {
+                   next unless ref $t; # skip text
+                   last if $t->[0] eq "/select";
+                   #print "select ", Dumper($t), "\n";
+                   if ($t->[0] eq "option") {
+                       my $value = $t->[1]->{value};
+                       my $text = get_text($p, "/option");
+                       unless (defined $value) {
+                           $value = decode_entities($text);
+                       }
+                       push(@$sel, $value);
+                   }
+                   else {
+                       warn "$t->[0] inside select";
+                   }
+               }
+           }
+           elsif ($t->[0] =~ /^\/?option$/) {
+               warn "option tag outside select";
+           }
+           elsif ($t->[0] eq "textarea") {
+               push(@{$forms[-1]}, $t);
+               $t->[1]{value} = get_text($p, "/textarea");
+           }
+           elsif ($t->[0] =~ m,^/,) {
+               warn "stray $t->[0] tag";
+           }
+           else {
+               push(@{$forms[-1]}, $t);
+           }
+       }
+    }
+    else {
+       warn "form tag $t->[0] outside form";
+    }
+}
+
+print Dumper(\@forms), "\n";