Skip Menu |
 

This queue is for tickets about the libwww-perl CPAN distribution.

Report information
The Basics
Id: 32239
Status: resolved
Priority: 0/
Queue: libwww-perl

People
Owner: Nobody in particular
Requestors: davidrw [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: 5.10
Fixed in: (no value)



Subject: [patch] warn if TextInput's maxlength exceeded
Download (untitled) / with headers
text/plain 590b
Attached patch adds a warning if a HTML::Form::TextInput object has a maxlength attribute, and the value is changed to something longer than that maxlength. This came up here: http://perlmonks.org/?node_id=661065 And continued here: http://perlmonks.org/?node_id=661086 In addition to (or in lieu of) the above, any thoughts on adding a feature to optionally (mechanism of option??) croak instead? ~~~ libwww-perl-5.808; test suite passes before & after patch This is perl, v5.6.1 built for i386-linux Linux dev.example.com 2.4.21-32.0.1.EL #1 Wed May 25 16:02:04 CDT 2005 i686 unknown
Subject: maxlength.patch
Download maxlength.patch
text/x-diff 696b
*** HTML/Form-v1.054.pm Sun Aug 5 09:39:26 2007 --- HTML/Form.pm Wed Jan 9 10:19:42 2008 *************** *** 964,970 **** if (@_) { Carp::carp("Input '$self->{name}' is readonly") if $^W && $self->{readonly}; ! $self->{value} = shift; } $old; } --- 964,974 ---- if (@_) { Carp::carp("Input '$self->{name}' is readonly") if $^W && $self->{readonly}; ! my $new = shift; ! my $n = exists $self->{maxlength} ? $self->{maxlength} : undef; ! Carp::carp("Input '$self->{name}' has maxlength '$n'") ! if $^W && defined($n) && defined($new) && length($new) > $n; ! $self->{value} = $new; } $old; }
Subject: maxlength.t
Download maxlength.t
text/x-perl 1.8k
#!/usr/bin/perl use strict; use warnings; use lib '.'; use Test::More tests => 16; use HTML::Form; my $html = do { local $/ = undef; <DATA> }; my $form = HTML::Form->parse($html, 'foo.html' ); isa_ok($form, 'HTML::Form'); my $input = $form->find_input('passwd'); isa_ok($input, 'HTML::Form::TextInput'); sub set_value { my $input = shift; my $value = shift; my $len = length($value); my $old = $input->value; is( $input->value($value), $old, "set value length=$len" ); is( $input->value, $value, "got value length=$len" ); } { my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_; }; is( $input->{maxlength}, 8, 'got maxlength: 8' ); $^W = 0; set_value( $input, '1234' ); is( @warnings, 0, "No warnings so far" ); set_value( $input, '1234567890' ); is( @warnings, 0, "No warnings so far" ); $^W = 1; set_value( $input, '1234' ); is( @warnings, 0, "No warnings so far" ); set_value( $input, '1234567890' ); is( @warnings, 1, "Got warning" ); like( $warnings[0], qr/^Input 'passwd' has maxlength '8' at /, "Got warning message" ); } __DATA__ <form method="post" action="?" enctype="application/x-www-form-urlencoded" name="login"> <div style="display:none"><input type="hidden" name="node_id" value="109"></div> <input type="hidden" name="op" value="login" /> <input type="hidden" name="lastnode_id" value="109" /> <table border="0"><tr><td><font size="2"> Login:</font></td><td> <input type="text" name="user" size=10 maxlength=34 /> </td></tr><tr><td><font size="2"> Password</font></td><td> <input type="password" name="passwd" size=10 MAXLENGTH=8 /> </td></tr></table><font size="2"> <input type="checkbox" name="expires" value="+10y" />remember me <input type="submit" name="login" value="Login" /> </font><br /> <a href="?node=What%27s%20my%20password%3F">password reminder</a> <br /> <a href="?node_id=101">Create A New User</a> </form>
Applied.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.