[Catalyst-commits] r9963 - in
trunk/Catalyst-Plugin-Unicode-Encoding: .
lib/Catalyst/Plugin/Unicode t t/lib t/lib/TestApp/Controller
ash at dev.catalyst.perl.org
ash at dev.catalyst.perl.org
Thu Apr 30 16:46:33 GMT 2009
Author: ash
Date: 2009-04-30 17:46:33 +0100 (Thu, 30 Apr 2009)
New Revision: 9963
Added:
trunk/Catalyst-Plugin-Unicode-Encoding/t/04live.t
trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/
Removed:
trunk/Catalyst-Plugin-Unicode-Encoding/Build.PL
trunk/Catalyst-Plugin-Unicode-Encoding/MANIFEST
trunk/Catalyst-Plugin-Unicode-Encoding/META.yml
trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/Makefile.PL
trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/script/
Modified:
trunk/Catalyst-Plugin-Unicode-Encoding/Changes
trunk/Catalyst-Plugin-Unicode-Encoding/Makefile.PL
trunk/Catalyst-Plugin-Unicode-Encoding/lib/Catalyst/Plugin/Unicode/Encoding.pm
trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/TestApp.pm
trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/TestApp/Controller/Root.pm
Log:
- Switch to Module::Install
- Require Catalyst 5.8
- Allow setting undef encoding (per request) to disable default of UTF-8
- Don't overwrite encoding set in content types: "text/html; charset=utf-8"
- Handles the latin-1 (i.e. e-accute) case of encoding that everyone else forgets
- Copy live tests from Catalyst::Plugin::Encoding
Deleted: trunk/Catalyst-Plugin-Unicode-Encoding/Build.PL
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/Build.PL 2009-04-30 16:40:30 UTC (rev 9962)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/Build.PL 2009-04-30 16:46:33 UTC (rev 9963)
@@ -1,18 +0,0 @@
-use strict;
-use Module::Build;
-
-my $build = Module::Build->new(
- create_makefile_pl => 'passthrough',
- license => 'perl',
- module_name => 'Catalyst::Plugin::Unicode::Encoding',
- requires => {
- 'Catalyst' => 5.20,
- 'Encode' => 2.10
- },
- create_makefile_pl => 'passthrough',
- test_files => [
- glob('t/*.t')
- ]
-);
-
-$build->create_build_script;
Modified: trunk/Catalyst-Plugin-Unicode-Encoding/Changes
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/Changes 2009-04-30 16:40:30 UTC (rev 9962)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/Changes 2009-04-30 16:46:33 UTC (rev 9963)
@@ -1,5 +1,15 @@
Revision history for Perl extension Catalyst::Plugin::Unicode::Encoding
+ - Switch to Module::Install
+ - Require Catalyst 5.8
+ - Allow setting undef encoding (per request) to disable default of
+ UTF-8
+ - Don't overwrite encoding set in content types:
+ "text/html; charset=utf-8"
+ - Handles the latin-1 (i.e. e-accute) case of encoding that everyone
+ else forgets
+ - Copy live tests from Catalyst::Plugin::Encoding
+
0.2 2009-04-28 11:43:00
- Switch to MRO::Compat for Catalyst 5.8
Deleted: trunk/Catalyst-Plugin-Unicode-Encoding/MANIFEST
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/MANIFEST 2009-04-30 16:40:30 UTC (rev 9962)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/MANIFEST 2009-04-30 16:46:33 UTC (rev 9963)
@@ -1,10 +0,0 @@
-Build.PL
-Changes
-lib/Catalyst/Plugin/Unicode/Encoding.pm
-Makefile.PL
-MANIFEST This list of files
-META.yml
-README
-t/01use.t
-t/02pod.t
-t/03podcoverage.t
Deleted: trunk/Catalyst-Plugin-Unicode-Encoding/META.yml
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/META.yml 2009-04-30 16:40:30 UTC (rev 9962)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/META.yml 2009-04-30 16:46:33 UTC (rev 9963)
@@ -1,20 +0,0 @@
----
-name: Catalyst-Plugin-Unicode-Encoding
-version: 0.2
-author:
- - 'Christian Hansen, C<ch at ngmedia.com>'
-abstract: Unicode aware Catalyst
-license: perl
-resources:
- license: http://dev.perl.org/licenses/
-requires:
- Catalyst: 5.2
- Encode: 2.1
-provides:
- Catalyst::Plugin::Unicode::Encoding:
- file: lib/Catalyst/Plugin/Unicode/Encoding.pm
- version: 0.2
-generated_by: Module::Build version 0.3
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
Modified: trunk/Catalyst-Plugin-Unicode-Encoding/Makefile.PL
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/Makefile.PL 2009-04-30 16:40:30 UTC (rev 9962)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/Makefile.PL 2009-04-30 16:46:33 UTC (rev 9963)
@@ -1,31 +1,10 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.30
-
- unless (eval "use Module::Build::Compat 0.02; 1" ) {
- print "This module requires Module::Build to install itself.\n";
-
- require ExtUtils::MakeMaker;
- my $yn = ExtUtils::MakeMaker::prompt
- (' Install Module::Build now from CPAN?', 'y');
-
- unless ($yn =~ /^y/i) {
- die " *** Cannot install without Module::Build. Exiting ...\n";
- }
-
- require Cwd;
- require File::Spec;
- require CPAN;
-
- # Save this 'cause CPAN will chdir all over the place.
- my $cwd = Cwd::cwd();
-
- CPAN::Shell->install('Module::Build::Compat');
- CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
- or die "Couldn't install Module::Build, giving up.\n";
-
- chdir $cwd or die "Cannot chdir() back to $cwd: $!";
- }
- eval "use Module::Build::Compat 0.02; 1" or die $@;
-
- Module::Build::Compat->run_build_pl(args => \@ARGV);
- require Module::Build;
- Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+use inc::Module::Install 0.81;
+
+all_from 'lib/Catalyst/Plugin/Unicode/Encoding.pm';
+
+requires 'Encode' => 2.21;
+requires 'Catalyst' => 5.80;
+
+test_requires 'Test::WWW::Mechanize::Catalyst' => 0.51;
+
+WriteAll;
Modified: trunk/Catalyst-Plugin-Unicode-Encoding/lib/Catalyst/Plugin/Unicode/Encoding.pm
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/lib/Catalyst/Plugin/Unicode/Encoding.pm 2009-04-30 16:40:30 UTC (rev 9962)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/lib/Catalyst/Plugin/Unicode/Encoding.pm 2009-04-30 16:46:33 UTC (rev 9963)
@@ -4,7 +4,7 @@
use base 'Class::Data::Inheritable';
use Carp ();
-use Encode 2.10 ();
+use Encode 2.21 ();
use MRO::Compat;
our $VERSION = '0.2';
@@ -14,44 +14,52 @@
sub encoding {
my $c = shift;
-
- if ( ref($c) ) { # instance
-
- if ( my $wanted = shift(@_) ) {
-
- $c->{encoding} = Encode::find_encoding($wanted)
+ my $encoding;
+ if ( scalar @_ ) {
+ # Let it be set to undef
+ if (my $wanted = shift) {
+ $encoding = Encode::find_encoding($wanted)
or Carp::croak( qq/Unknown encoding '$wanted'/ );
}
- if ( $c->{encoding} ) {
- return $c->{encoding};
- }
+ $encoding = ref $c
+ ? $c->{encoding} = $encoding
+ : $c->_encoding($encoding);
+ } else {
+ $encoding = ref $c && exists $c->{encoding}
+ ? $c->{encoding}
+ : $c->_encoding;
}
- if ( my $wanted = shift(@_) ) {
-
- my $encoding = Encode::find_encoding($wanted)
- or Carp::croak( qq/Unknown encoding '$wanted'/ );
-
- $c->_encoding($encoding);
- }
-
- return $c->_encoding;
+ return $encoding;
}
sub finalize {
my $c = shift;
- unless ( $c->response->body ) {
- return $c->next::method(@_);
- }
+ return $c->next::method(@_)
+ unless $c->response->body;
- unless ( $c->response->content_type =~ /^text|xml$|javascript$/ ) {
- return $c->next::method(@_);
- }
+ my $enc = $c->encoding;
- unless ( Encode::is_utf8( $c->response->body ) ) {
- return $c->next::method(@_);
+ return $c->next::method(@_)
+ unless $enc;
+
+ my ($ct,$ct_enc) = $c->response->content_type;
+
+ # Only touch 'text-like' contents
+ return $c->next::method(@_)
+ unless $c->response->content_type =~ /^text|xml$|javascript$/;
+
+ if ($ct_enc && $ct_enc =~ /charset=(.*?)$/) {
+ if (uc($1) ne $enc->mime_name) {
+ $c->log->debug("Unicode::Encoding is set to encode in '" .
+ $enc->mime_name .
+ "', content type is '$1', not encoding ");
+ return $c->next::method(@_);
+ }
+ } else {
+ $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
}
$c->response->body( $c->encoding->encode( $c->response->body, $CHECK ) );
@@ -64,22 +72,29 @@
$c->next::method(@_);
+ my $enc = $c->encoding;
+
for my $value ( values %{ $c->request->{parameters} } ) {
+ # TODO: Hash support from the Params::Nested
if ( ref $value && ref $value ne 'ARRAY' ) {
next;
}
- $_ = $c->encoding->decode( $_, $CHECK ) for ( ref($value) ? @{$value} : $value );
+ $_ = $enc->decode( $_, $CHECK ) for ( ref($value) ? @{$value} : $value );
}
}
sub setup {
my $self = shift;
- $self->encoding( $self->config->{encoding} || 'UTF-8' );
+ my $conf = $self->config;
- $self->next::method(@_);
+ # Allow an explict undef encoding to disable default of utf-8
+ my $enc = exists $conf->{encoding} ? $conf->{encoding} : 'UTF-8';
+ $self->encoding( $enc );
+
+ return $self->next::method(@_);
}
1;
Copied: trunk/Catalyst-Plugin-Unicode-Encoding/t/04live.t (from rev 6866, trunk/Catalyst-Plugin-Unicode/t/live-test.t)
===================================================================
--- trunk/Catalyst-Plugin-Unicode-Encoding/t/04live.t (rev 0)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/t/04live.t 2009-04-30 16:46:33 UTC (rev 9963)
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 21;
+use utf8;
+use IO::Scalar;
+
+# setup library path
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+
+# make sure testapp works
+BEGIN { use_ok('TestApp') or BAIL_OUT($@) };
+
+our $TEST_FILE = IO::Scalar->new(\"this is a test");
+sub IO::Scalar::FILENO { -1 }; # needed?
+
+# a live test against TestApp, the test application
+use Test::WWW::Mechanize::Catalyst 'TestApp';
+my $mech = Test::WWW::Mechanize::Catalyst->new;
+$mech->get_ok('http://localhost/', 'get main page');
+$mech->content_like(qr/it works/i, 'see if it has our text');
+is ($mech->response->header('Content-Type'), 'text/html; charset=UTF-8',
+ 'Content-Type with charset'
+);
+
+my $hoge_utf8 = "ほげ";
+{
+ $mech->get_ok('http://localhost/unicode_no_enc', 'get unicode_no_enc');
+
+ my $octets = Encode::encode_utf8($hoge_utf8);
+ my $content = $mech->content;
+
+ is ($mech->response->header('Content-Type'), 'text/plain',
+ 'Content-Type with no charset');
+
+ # This was an is_utf8 check before, but WWW::Mech does a few silly things.
+ is($content, $octets, "not utf8");
+ # Just to double check that no autopromotion is going on
+ isnt($content, $hoge_utf8, "Bytes != string");
+ utf8::decode($content);
+
+ is( $content, $hoge_utf8, 'content contains hoge');
+}
+
+{
+ $mech->get_ok('http://localhost/unicode', 'get unicode');
+
+ is ($mech->response->header('Content-Type'), 'text/plain; charset=UTF-8',
+ 'Content-Type with charset');
+
+ is( $mech->content, $hoge_utf8, 'content contains hoge');
+}
+
+{
+ $mech->get_ok('http://localhost/not_unicode', 'get bytes');
+ my $content = $mech->content;
+ my $chars = "\x{1234}\x{5678}";
+ isnt($content, $chars);
+ utf8::encode($chars);
+ like $content, qr/$chars/, 'got 1234 5678';
+}
+
+{
+ $mech->get_ok('http://localhost/file', 'get file');
+ $mech->content_like(qr/this is a test/, 'got filehandle contents');
+}
+
+{
+ # The latin 1 case is the one everyone forgets. I want to really make sure
+ # its right, so lets check the damn bytes.
+ $mech->get_ok('http://localhost/latin1', 'get latin1');
+ is ($mech->response->header('Content-Type'), 'text/plain; charset=UTF-8',
+ 'Content-Type with charset');
+
+ # Encode the utf8 string into bytes
+ my $bytes = Encode::encode_utf8($mech->content);
+
+ is ($bytes, "LATIN SMALL LETTER E WITH ACUTE: \x{C3}\x{A9}",
+ 'content bytes are utf8'
+ );
+ is ($mech->content, "LATIN SMALL LETTER E WITH ACUTE: \x{E9}",
+ 'content string matches from latin1'
+ );
+}
Copied: trunk/Catalyst-Plugin-Unicode-Encoding/t/lib (from rev 6866, trunk/Catalyst-Plugin-Unicode/t/lib)
Deleted: trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/Makefile.PL
===================================================================
Modified: trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/TestApp/Controller/Root.pm
===================================================================
--- trunk/Catalyst-Plugin-Unicode/t/lib/TestApp/Controller/Root.pm 2007-09-12 10:36:58 UTC (rev 6866)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/TestApp/Controller/Root.pm 2009-04-30 16:46:33 UTC (rev 9963)
@@ -8,14 +8,25 @@
use base 'Catalyst::Controller';
# your actions replace this one
-sub main :Path {
- $_[1]->res->body('<h1>It works</h1>')
+sub main :Path('') {
+ $_[1]->res->body('<h1>It works</h1>');
+ $_[1]->res->content_type('text/html');
}
+sub unicode_no_enc :Local {
+ my ($self, $c) = @_;
+ my $data = "ほげ"; # hoge!
+ utf8::encode($data);
+ $c->response->body($data);
+ $c->res->content_type('text/plain');
+ $c->encoding(undef);
+}
+
sub unicode :Local {
my ($self, $c) = @_;
my $data = "ほげ"; # hoge!
$c->response->body($data); # should be decoded
+ $c->res->content_type('text/plain');
}
sub not_unicode :Local {
@@ -23,8 +34,17 @@
my $data = "\x{1234}\x{5678}";
utf8::encode($data); # DO NOT WANT unicode
$c->response->body($data); # just some octets
+ $c->res->content_type('text/plain');
+ $c->encoding(undef);
}
+sub latin1 :Local {
+ my ($self, $c) = @_;
+
+ $c->res->content_type('text/plain');
+ $c->response->body('LATIN SMALL LETTER E WITH ACUTE: é');
+}
+
sub file :Local {
my ($self, $c) = @_;
close *STDERR; # i am evil.
Modified: trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/TestApp.pm
===================================================================
--- trunk/Catalyst-Plugin-Unicode/t/lib/TestApp.pm 2007-09-12 10:36:58 UTC (rev 6866)
+++ trunk/Catalyst-Plugin-Unicode-Encoding/t/lib/TestApp.pm 2009-04-30 16:46:33 UTC (rev 9963)
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Catalyst qw/Unicode/;
+use Catalyst qw/Unicode::Encoding/;
__PACKAGE__->setup;
More information about the Catalyst-commits
mailing list