FM / examples

/usr/share/doc/libhtml-parser-perl/examples/

/usr/share/doc/libhtml-parser-perl/examples

Name	Size	Mode	Actions
hanchors	1165	0755	edit dl rm
hdump	683	0755	edit dl rm
hform	1918	0755	edit dl rm
hlc	710	0755	edit dl rm
hrefsub	2782	0755	edit dl rm
hstrip	1780	0755	edit dl rm
htext	575	0755	edit dl rm
htextsub	955	0755	edit dl rm
htitle	434	0755	edit dl rm
README	1085	0644	edit dl rm

Edit: /usr/share/doc/libhtml-parser-perl/examples/hform (1918B)

#!/usr/bin/perl -w

# Print information about forms and their controls present in the HTML.
# See also HTML::Form module

use HTML::PullParser ();
use HTML::Entities qw(decode_entities);
use Data::Dump qw(dump);

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 ", dump($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 dump(\@forms), "\n";

cmd: