| Subject: | Interface for accesing labels in HTML::Form inputs |
I ask you to add interface for accessing input labels. It is currently
possible to get input's label through the $input->{value_name} in some
cases, but it not always corresponds to label. If label for input does
not exist, parser do some heuristic to guess "value_name" and swallow
all plain text following input through $p->get_phrase.
Furthermore current value_name parsing has a flaw: if label defined
after the input, the label is ignored (because at the time of parsing
of the input element there is no corresponding entry in %labels).
I'm proposing a patch which implements the interface for accessing
labels and label assignment is free from mentioned flaw (labels
assigned to inputs when form completely parsed).
Attached:
- patch
- test script
| Subject: | test.pl |
#! /usr/bin/perl
use strict;
use warnings;
use HTML::Form;
local $/;
my $data = <DATA>;
foreach my $f (HTML::Form->parse($data, 'http://localhost/')) {
print "Form: " . $f->attr('name') . "\n";
foreach my $i ($f->inputs) {
print " Input: " . $i->name . "\n";
print " value_name:\t" . $i->{value_name} . "\n";
if ($i->can('label')) {
print " label:\t" . $i->label . "\n";
}
}
}
__DATA__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>Form test</title>
</head>
<body>
<form action="script.cgi" name="first">
<input id="q1" type="text" name="q">
Wrongly detected label
<label for="q1">Label for Q1</label>
</form>
<form action="script.cgi" name="second">
<label>
Label
<input type="text" name="q">
for Q2
</label>
</form>
<form action="script.cgi" name="third">
<label for="q3">Label for Q3</label>
<input id="q3" type="text" name="q">
</form>
<form action="script.cgi" name="fourth">
<input id="q3" type="text" name="q">
Not label at all
</form>
</body>
</html>
| Subject: | form-label.patch |
--- HTML/Form.pm.orig 2009-06-13 20:26:04.000000000 +0300
+++ HTML/Form.pm 2009-06-13 21:52:02.000000000 +0300
@@ -170,6 +170,7 @@
}
if ($tag eq "input") {
+ defined $current_label and $attr->{label} = $current_label;
$attr->{value_name} =
exists $attr->{id} && exists $labels{$attr->{id}} ? $labels{$attr->{id}} :
defined $current_label ? $current_label :
@@ -253,6 +254,11 @@
$f->push_input("keygen", $attr, $verbose);
}
}
+ for ($f->inputs) {
+ if (defined $_->{id} && defined (my $label = $labels{$_->{id}})) {
+ $_->{label} = $label;
+ }
+ }
}
elsif ($form_tags{$tag}) {
warn("<$tag> outside <form> in $base_uri\n") if $verbose;
@@ -959,6 +965,19 @@
return ($name => $value);
}
+=item $input->label
+
+Return the label corresponding to this input or C<undef> if no label
+defined.
+
+=cut
+
+sub label
+{
+ my $self = shift;
+ $self->{label};
+}
+
sub dump
{
my $self = shift;