Skip to content

Commit bd65c81

Browse files
gislegisle
committed
Simplifications to be made if we assume Encode 2.12 or better is available
1 parent 973f169 commit bd65c81

6 files changed

Lines changed: 32 additions & 95 deletions

File tree

‎lib/HTML/Form.pm‎

Lines changed: 5 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -3,13 +3,11 @@ package HTML::Form;
33
use strict;
44
use URI;
55
use Carp ();
6+
use Encode ();
67

7-
use vars qw($VERSION $Encode_available);
8+
use vars qw($VERSION);
89
$VERSION = "5.829";
910

10-
eval { require Encode };
11-
$Encode_available = !$@;
12-
1311
my %form_tags = map {$_ => 1} qw(input textarea button select option);
1412

1513
my %type2class = (
@@ -368,9 +366,7 @@ string like "application/x-www-form-urlencoded" or "multipart/form-data".
368366
This method gets/sets the list of charset encodings that the server processing
369367
the form accepts. Current implementation supports only one-element lists.
370368
Default value is "UNKNOWN" which we interpret as a request to use document
371-
charset as specified by the 'charset' parameter of the parse() method. To
372-
encode character strings you should have modern perl with Encode module. On
373-
older perls the setting of this attribute has no effect.
369+
charset as specified by the 'charset' parameter of the parse() method.
374370
375371
=cut
376372

@@ -694,10 +690,8 @@ sub make_request
694690
my @form = $self->form;
695691

696692
my $charset = $self->accept_charset eq "UNKNOWN" ? $self->{default_charset} : $self->accept_charset;
697-
if ($Encode_available) {
698-
foreach my $fi (@form) {
699-
$fi = Encode::encode($charset, $fi) unless ref($fi);
700-
}
693+
foreach my $fi (@form) {
694+
$fi = Encode::encode($charset, $fi) unless ref($fi);
701695
}
702696

703697
if ($method eq "GET") {

‎lib/HTTP/Message.pm‎

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -379,14 +379,6 @@ sub decoded_content
379379
}
380380
else {
381381
require Encode;
382-
if (do{my $v = $Encode::VERSION; $v =~ s/_//g; $v} < 2.0901 &&
383-
!$content_ref_iscopy)
384-
{
385-
# LEAVE_SRC did not work before Encode-2.0901
386-
my $copy = $$content_ref;
387-
$content_ref = \$copy;
388-
$content_ref_iscopy++;
389-
}
390382
eval {
391383
$content_ref = \Encode::decode($charset, $$content_ref,
392384
($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());

‎lib/HTTP/Response.pm‎

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -143,12 +143,8 @@ sub filename
143143
}
144144

145145
require Encode;
146-
require encoding;
147-
# This is ugly use of non-public API, but is there
148-
# a better way to accomplish what we want (locally
149-
# as-is usable filename string)?
150-
my $locale_charset = encoding::_get_locale_encoding();
151-
Encode::from_to($encfile, $charset, $locale_charset);
146+
require Encode::Locale;
147+
Encode::from_to($encfile, $charset, "locale_fs");
152148
};
153149

154150
$file = $encfile unless $@;

‎t/base/message-charset.t‎

Lines changed: 0 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -2,18 +2,6 @@
22

33
use strict;
44

5-
BEGIN {
6-
eval {
7-
require Encode;
8-
Encode::find_encoding("UTF-16-BE") || die "Need a version of Encode that supports UTF-16-BE";
9-
};
10-
if ($@) {
11-
print "1..0 # Skipped: Encode not available\n";
12-
print $@;
13-
exit;
14-
}
15-
}
16-
175
use Test;
186
plan tests => 38;
197

‎t/base/message.t‎

Lines changed: 25 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -359,10 +359,8 @@ $m->header("Content-Encoding", "gzip, base64");
359359
$m->content_type("text/plain; charset=UTF-8");
360360
$m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
361361

362-
my $NO_ENCODE = $] < 5.008 || ($Config{'extensions'} !~ /\bEncode\b/)
363-
? "No Encode module" : "";
364362
$@ = "";
365-
skip($NO_ENCODE, sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
363+
ok(sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
366364
ok($@ || "", "");
367365
ok($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
368366

@@ -377,17 +375,15 @@ my $tmp = MIME::Base64::decode($m->content);
377375
$m->content($tmp);
378376
$m->header("Content-Encoding", "gzip");
379377
$@ = "";
380-
skip($NO_ENCODE, sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
378+
ok(sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
381379
ok($@ || "", "");
382380
ok($m->content, $tmp);
383381

384382
$m->remove_header("Content-Encoding");
385383
$m->content("a\xFF");
386384

387-
my $BAD_ENCODE = $NO_ENCODE || !(eval { require Encode; defined(Encode::decode("UTF-8", "\xff")) });
388-
389-
skip($BAD_ENCODE, sub { $m->decoded_content }, "a\x{FFFD}");
390-
skip($BAD_ENCODE, sub { $m->decoded_content(charset_strict => 1) }, undef);
385+
ok(sub { $m->decoded_content }, "a\x{FFFD}");
386+
ok(sub { $m->decoded_content(charset_strict => 1) }, undef);
391387

392388
$m->header("Content-Encoding", "foobar");
393389
ok($m->decoded_content, undef);
@@ -401,36 +397,26 @@ eval {
401397
ok($@ =~ /Don't know how to decode Content-Encoding 'foobar'/);
402398
ok($err, 0);
403399

404-
if ($] >= 5.008001) {
405-
eval {
406-
HTTP::Message->new([], "\x{263A}");
407-
};
408-
ok($@ =~ /bytes/);
409-
$m = HTTP::Message->new;
410-
eval {
411-
$m->add_content("\x{263A}");
412-
};
413-
ok($@ =~ /bytes/);
414-
eval {
415-
$m->content("\x{263A}");
416-
};
417-
ok($@ =~ /bytes/);
418-
}
419-
else {
420-
skip("Missing is_utf8 test", undef) for 1..3;
421-
}
400+
eval {
401+
HTTP::Message->new([], "\x{263A}");
402+
};
403+
ok($@ =~ /bytes/);
404+
$m = HTTP::Message->new;
405+
eval {
406+
$m->add_content("\x{263A}");
407+
};
408+
ok($@ =~ /bytes/);
409+
eval {
410+
$m->content("\x{263A}");
411+
};
412+
ok($@ =~ /bytes/);
422413

423414
# test the add_content_utf8 method
424-
if ($] >= 5.008001) {
425-
$m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]);
426-
$m->add_content_utf8("\x{263A}");
427-
$m->add_content_utf8("-\xC5");
428-
ok($m->content, "\xE2\x98\xBA-\xC3\x85");
429-
ok($m->decoded_content, "\x{263A}-\x{00C5}");
430-
}
431-
else {
432-
skip("Missing is_utf8 test", undef) for 1..2;
433-
}
415+
$m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]);
416+
$m->add_content_utf8("\x{263A}");
417+
$m->add_content_utf8("-\xC5");
418+
ok($m->content, "\xE2\x98\xBA-\xC3\x85");
419+
ok($m->decoded_content, "\x{263A}-\x{00C5}");
434420

435421
$m = HTTP::Message->new([
436422
"Content-Type", "text/plain",
@@ -453,11 +439,7 @@ Content-Type: text/plain
453439
454440
eJzzSM3JyVcozy/KSVEEAB0JBF4=
455441
EOT
456-
if (eval { require Encode; 1 }) {
457-
ok($m->decoded_content, "Hello world!");
458-
} else {
459-
skip('Needs Encode.pm for this test', undef);
460-
}
442+
ok($m->decoded_content, "Hello world!");
461443

462444
# Raw RFC 1951 deflate
463445
$m = HTTP::Message->new([
@@ -503,10 +485,5 @@ else {
503485
}
504486

505487
# test decoding of XML content
506-
if ($] >= 5.008001) {
507-
$m = HTTP::Message->new(["Content-Type", "application/xml"], "\xFF\xFE<\0?\0x\0m\0l\0 \0v\0e\0r\0s\0i\0o\0n\0=\0\"\x001\0.\x000\0\"\0 \0e\0n\0c\0o\0d\0i\0n\0g\0=\0\"\0U\0T\0F\0-\x001\x006\0l\0e\0\"\0?\0>\0\n\0<\0r\0o\0o\0t\0>\0\xC9\0r\0i\0c\0<\0/\0r\0o\0o\0t\0>\0\n\0");
508-
ok($m->decoded_content, "<?xml version=\"1.0\"?>\n<root>\xC9ric</root>\n");
509-
}
510-
else {
511-
skip("Need perl-5.8", undef) for 1..1;
512-
}
488+
$m = HTTP::Message->new(["Content-Type", "application/xml"], "\xFF\xFE<\0?\0x\0m\0l\0 \0v\0e\0r\0s\0i\0o\0n\0=\0\"\x001\0.\x000\0\"\0 \0e\0n\0c\0o\0d\0i\0n\0g\0=\0\"\0U\0T\0F\0-\x001\x006\0l\0e\0\"\0?\0>\0\n\0<\0r\0o\0o\0t\0>\0\xC9\0r\0i\0c\0<\0/\0r\0o\0o\0t\0>\0\n\0");
489+
ok($m->decoded_content, "<?xml version=\"1.0\"?>\n<root>\xC9ric</root>\n");

‎t/html/form-unicode.t‎

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,6 @@
11
#!perl -w
22

33
use strict;
4-
BEGIN {
5-
eval {
6-
require Encode;
7-
};
8-
if ($@) {
9-
print "1..0 # Skipped: Encode not available\n";
10-
print $@;
11-
exit;
12-
}
13-
}
144

155
use Test qw(plan ok);
166
plan tests => 15;

0 commit comments

Comments
 (0)