| Server IP : 74.208.127.88 / Your IP : 216.73.216.156 Web Server : Apache/2.4.41 (Ubuntu) System : Linux ubuntu 5.4.0-163-generic #180-Ubuntu SMP Tue Sep 5 13:21:23 UTC 2023 x86_64 User : www-data ( 33) PHP Version : 7.4.3-4ubuntu2.29 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /proc/self/root/proc/self/root/usr/share/doc/libhtml-parser-perl/examples/ |
Upload File : |
#!/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";