@@ -1,5 +1,15 @@
Revision history for Perl extension Catalyst::View::JSON
+0.30 Tue Apr 13 01:14:07 CEST 2010
+ - Fix test application to call $c->forward('View::JSON') rather than
+ (the incorrect) $c->forward('MyApp::View::JSON')
+ - Fix documentation to match the above change
+ - Turn off the regex fallback behavior in the test applications on
+ newer Catalyst versions to ensure tests are correctly forwarding.
+ - Move actions out of the test application classes into controller
+ classes to avoid deprecation warnings on newer Catalyst releases.
+ - 0.29 had unintended commits accidentally pulled from ap/master. Reverted
+
0.28 Wed Mar 10 11:19:35 JST 2010
- No code changes. Fixed packaging, added YAML dep for testing
@@ -16,7 +16,9 @@ META.yml
t/00_compile.t
t/01_server.t
t/lib/TestApp.pm
+t/lib/TestApp/Controller/Root.pm
t/lib/TestApp/View/JSON.pm
t/lib/TestApp/View/JSON2.pm
t/lib/TestAppUnicode.pm
+t/lib/TestAppUnicode/Controller/Root.pm
t/lib/TestAppUnicode/View/JSON.pm
@@ -9,7 +9,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.94'
+generated_by: 'Module::Install version 0.95'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -27,4 +27,4 @@ requires:
resources:
license: http://dev.perl.org/licenses/
repository: git://github.com/miyagawa/catalyst-view-json.git
-version: 0.28
+version: 0.30
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.94';
+ $VERSION = '0.95';
}
# Suspend handler for "redefined" warnings
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.94';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.94';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -7,7 +7,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.94';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -25,8 +25,8 @@ sub prompt {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
- # In automated testing, always use defaults
- if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
@@ -45,10 +45,88 @@ sub makemaker {
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
sub makemaker_args {
- my $self = shift;
+ my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
return $args;
}
@@ -58,8 +136,8 @@ sub makemaker_append {
my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
- $args->{name} = defined $args->{$name}
- ? join( ' ', $args->{name}, @_ )
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
@@ -158,12 +236,20 @@ sub write {
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
$DB::single = 1;
if ( $self->tests ) {
+ my @tests = split ' ', $self->tests;
+ my %seen;
$args->{test} = {
- TESTS => $self->tests,
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
};
} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
$args->{test} = {
@@ -172,7 +258,7 @@ sub write {
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
}
if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
@@ -184,6 +270,9 @@ sub write {
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
@@ -233,7 +322,10 @@ sub write {
}
}
- $args->{INSTALLDIRS} = $self->installdirs;
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
my %args = map {
( $_ => $args->{$_} ) } grep {defined($args->{$_} )
@@ -310,4 +402,4 @@ sub postamble {
__END__
-#line 439
+#line 531
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.94';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -19,7 +19,6 @@ my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -43,8 +42,11 @@ my @resource_keys = qw{
my @array_keys = qw{
keywords
+ author
};
+*authors = \&author;
+
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
@@ -242,7 +244,7 @@ sub all_from {
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless $self->author;
+ $self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -428,8 +430,49 @@ sub author_from {
([^\n]*)
/ixms) {
my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
@@ -437,44 +480,47 @@ sub author_from {
}
sub _extract_license {
- if (
- $_[0] =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyrights?|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
- 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
- 'Artistic and GPL' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s#\s+#\\s+#gs;
- if ( $license_text =~ /\b$pattern\b/i ) {
- return $license;
- }
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:licen[cs]e|licensing)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /ixms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:copyrights?|legal)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /ixms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
+ 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
}
- } else {
- return;
}
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.94';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.94';;
+ $VERSION = '0.95';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -26,7 +26,10 @@ sub WriteAll {
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
@@ -19,6 +19,10 @@ package Module::Install;
use 5.005;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+use FindBin;
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -28,7 +32,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.94';
+ $VERSION = '0.95';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -38,18 +42,25 @@ BEGIN {
}
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
-
-
-
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
@@ -61,26 +72,28 @@ not:
END_DIE
-
-
-
-
-# If the script that is loading Module::Install is from the future,
-# then make will detect this and cause it to re-run over and over
-# again. This is bad. Rather than taking action to touch it (which
-# is unreliable on some platforms and requires write permissions)
-# for now we should catch this and refuse to run.
-if ( -f $0 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
@@ -89,15 +102,12 @@ This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
-}
-
-
-
+ }
-# Build.PL was formerly supported, but no longer is due to excessive
-# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
@@ -107,23 +117,36 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
+ #-------------------------------------------------------------
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+ #-------------------------------------------------------------
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
-# To save some more typing in Module::Install installers, every...
-# use inc::Module::Install
-# ...also acts as an implicit use strict.
-$^H |= strict::bits(qw(refs subs vars));
-
-
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+ # Save to the singleton
+ $MAIN = $self;
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
+ return 1;
+}
sub autoload {
my $self = shift;
@@ -152,33 +175,6 @@ sub autoload {
};
}
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
@@ -1,7 +1,7 @@
package Catalyst::View::JSON;
use strict;
-our $VERSION = '0.28';
+our $VERSION = '0.30';
use 5.008_001;
use base qw( Catalyst::View );
@@ -154,7 +154,7 @@ Catalyst::View::JSON - JSON view for your data
sub hello : Local {
my($self, $c) = @_;
$c->stash->{message} = 'Hello World!';
- $c->forward('MyApp::View::JSON');
+ $c->forward('View::JSON');
}
=head1 DESCRIPTION
@@ -287,7 +287,7 @@ For example, suppose you have the following code.
sub end : Private {
my($self, $c) = @_;
if ($c->req->param('output') eq 'json') {
- $c->forward('MyApp::View::JSON');
+ $c->forward('View::JSON');
} else {
...
}
@@ -421,6 +421,7 @@ John Wang
kazeburo
Daisuke Murase
Jun Kuriyama
+Tomas Doran
=head1 SEE ALSO
@@ -0,0 +1,58 @@
+package TestApp::Controller::Root;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Controller';
+
+__PACKAGE__->config(namespace => '');
+
+sub foo : Global {
+ my ( $self, $c ) = @_;
+
+ $c->component('View::JSON')->expose_stash(qr/^json_/);
+ $c->stash->{json_foo} = "bar";
+ $c->stash->{json_baz} = [ 1, 2, 3 ];
+ $c->stash->{foo} = "barbarbar";
+
+ $c->forward('View::JSON');
+}
+
+sub foo2 : Global {
+ my( $self, $c ) = @_;
+
+ $c->component('View::JSON')->expose_stash('json_baz');
+ $c->stash->{json_foo} = "bar";
+ $c->stash->{json_baz} = [ 1, 2, 3 ];
+
+ $c->forward('View::JSON');
+}
+
+sub foo3 : Global {
+ my( $self, $c ) = @_;
+ $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
+ $c->component('View::JSON')->encoding('utf-8');
+ $c->forward('View::JSON');
+}
+
+sub foo4 : Global {
+ my( $self, $c ) = @_;
+ $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
+ $c->component('View::JSON')->encoding('euc-jp');
+ $c->forward('View::JSON');
+}
+
+sub foo5 : Global {
+ my( $self, $c ) = @_;
+ $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
+ $c->component('View::JSON')->no_x_json_header(1);
+ $c->forward('View::JSON');
+}
+
+sub foo6 : Global {
+ my( $self, $c ) = @_;
+ $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
+ $c->forward('View::JSON2');
+}
+
+1;
@@ -9,6 +9,7 @@ use Catalyst;
our $VERSION = '0.01';
__PACKAGE__->config({
name => 'TestApp',
+ disable_component_resolution_regex_fallback => 1,
'View::JSON' => {
expose_stash => qr/^json_/,
allow_callback => 1,
@@ -18,54 +19,6 @@ __PACKAGE__->config({
__PACKAGE__->setup;
-sub foo : Global {
- my ( $self, $c ) = @_;
-
- $c->component('View::JSON')->expose_stash(qr/^json_/);
- $c->stash->{json_foo} = "bar";
- $c->stash->{json_baz} = [ 1, 2, 3 ];
- $c->stash->{foo} = "barbarbar";
-
- $c->forward('TestApp::View::JSON');
-}
-
-sub foo2 : Global {
- my( $self, $c ) = @_;
-
- $c->component('View::JSON')->expose_stash('json_baz');
- $c->stash->{json_foo} = "bar";
- $c->stash->{json_baz} = [ 1, 2, 3 ];
-
- $c->forward('TestApp::View::JSON');
-}
-
-sub foo3 : Global {
- my( $self, $c ) = @_;
- $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
- $c->component('View::JSON')->encoding('utf-8');
- $c->forward('TestApp::View::JSON');
-}
-
-sub foo4 : Global {
- my( $self, $c ) = @_;
- $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
- $c->component('View::JSON')->encoding('euc-jp');
- $c->forward('TestApp::View::JSON');
-}
-
-sub foo5 : Global {
- my( $self, $c ) = @_;
- $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
- $c->component('View::JSON')->no_x_json_header(1);
- $c->forward('TestApp::View::JSON');
-}
-
-sub foo6 : Global {
- my( $self, $c ) = @_;
- $c->stash->{json_foo} = "\x{5bae}\x{5ddd}";
- $c->forward('TestApp::View::JSON2');
-}
-
sub finalize_error {
my $c = shift;
$c->res->header('X-Error' => $c->error->[0]);
@@ -0,0 +1,16 @@
+package TestAppUnicode::Controller::Root;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Controller';
+
+__PACKAGE__->config(namespace => '');
+
+sub foo : Global {
+ my ( $self, $c ) = @_;
+ $c->stash->{foo} = "\x{30c6}\x{30b9}\x{30c8}";
+ $c->forward('View::JSON');
+}
+
+1;
@@ -7,6 +7,7 @@ use Catalyst qw( Unicode );
__PACKAGE__->config({
name => 'TestAppUnicode',
+ disable_component_resolution_regex_fallback => 1,
'View::JSON' => {
allow_callback => 1,
callback_param => 'cb',
@@ -15,10 +16,4 @@ __PACKAGE__->config({
__PACKAGE__->setup;
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->stash->{foo} = "\x{30c6}\x{30b9}\x{30c8}";
- $c->forward('TestAppUnicode::View::JSON');
-}
-
1;