Feature: encoder modules through get_encoder

This helps avoid using ugly _json_internal hack and may also be quite
useful in other scenarios.

Changes

@@ -4,15 +4,20 @@
             - Added Kelp::Util::adapt_psgi function (used by the new 'psgi' route flag)
             - Added a bunch of new methods with suffix '_param' to Kelp::Request, which work like 'param' but fetch from specific place
             - Methods with prefix 'raw_' were added to Kelp::Request, returning encoded request data (see "Bug fixes" below)
-            - Added charset_encode, charset_decode, is_production methods to Kelp
+            - Added charset_encode, charset_decode, is_production, get_encoder methods to Kelp
             - Added charset, charset_encode, charset_decode methods to Kelp::Request
             - Added set_charset method to Kelp::Response
+            - Added Kelp::Module::Encoder, a base class for encoders (to be used by the new get_encoder method)
             - Module::Template now inserts an 'app' parameter to render variables unless 'app' is already provided
 
             [Changes]
             - 'render' method will now assume you passed a json-encoded string if content type is json and body is not a reference
             - Kelp::Test no longer uses HTTP::Cookies, implements a much slimmer cookie jar with the same interface
               * The new cookie jar only stores key/value pairs without any special data for cookies like domains, paths or expiration dates
+            - Framework now internally uses a utf8-disabled JSON encoder
+              * The extra encoder will be created with the same options as the normal one, but without utf8
+              * It will no longer react to runtime changes in config of the main encoder
+              * Application will now encode the JSON response manually using proper charset
             - Kelp::Test now has a new import flag: '-utf8'
               * Importing with this flag will automatically set Test::More to encode wide characters on output
             - Repeatedly fetching parameters from json request with the param method is now much faster
@@ -37,10 +42,6 @@
               * Headers, cookies and sessions are unaffected (session encoding must be configured on the middleware level)
               * Please use methods with prefix 'raw_' from Kelp::Request to access encoded request data if needed
               * Not decoding input was a bug which needed to be fixed, but the application was already encoding the response correctly
-            - JSON module now registers a second, separate encoder for internal purposes
-              * The extra encoder will be created with the same options as the normal one, but without utf8
-              * It will not react to runtime changes in config of the main encoder
-              * Decodes and encodes will happen using the extra encoder and decode/encode to application's charset
             - Kelp::Exception no longer renders its body attribute, but instead logs it if it is present
               * Throwing Kelp::Exception now produces error template or plaintext response with proper HTTP status string
               * Log will happen at 'error' level, while regular errors are going to 'critical'

lib/Kelp.pm

@@ -44,6 +44,9 @@ attr -loaded_modules => sub { {} };
 attr req => undef;
 attr res => undef;
 
+# registered application encoder modules
+attr encoder_modules => sub { {} };
+
 # Initialization
 sub new
 {
@@ -392,6 +395,16 @@ sub charset_decode
     return decode $self->charset, $string;
 }
 
+sub get_encoder
+{
+    my ($self, $type, $name) = @_;
+
+    my $encoder = $self->encoder_modules->{$type} //
+        croak "No $type encoder";
+
+    return $encoder->get_encoder($name);
+}
+
 1;
 
 __END__
@@ -585,6 +598,7 @@ contain a reference to the current L<Kelp::Request> instance.
         }
     }
 
+
 =head2 res
 
 This attribute only makes sense if called within a route definition. It will
@@ -595,6 +609,11 @@ contain a reference to the current L<Kelp::Response> instance.
         $self->res->json->render( { success => 1 } );
     }
 
+=head2 encoder_modules
+
+A hash reference of registered encoder modules. Should only be interacted with
+through L</get_encoder> or inside encoder module's code.
+
 =head1 METHODS
 
 =head2 new
@@ -788,6 +807,24 @@ Shortcut methods, which encode or decode a string using the application's curren
 Returns whether the application is in production mode. Checks if L</mode> is
 either C<deployment> or C<production>.
 
+=head2 get_encoder
+
+    my $json_encoder = $self->get_encoder('json');
+
+Gets an instance of a given encoder. It takes two arguments:
+
+=over
+
+=item * type of the encoder module (eg. C<json>)
+
+=item * optional name of the encoder (default is C<default>)
+
+=back
+
+It will get extra config (if available) from C<encoders.TYPE.NAME>
+configuration hash. Will instantiate the encoder just once and then reuse it.
+Croaks when there is no such encoder type.
+
 =head1 AUTHOR
 
 Stefan Geneshky - minimal <at> cpan.org

lib/Kelp/Module/Config.pm

@@ -38,6 +38,15 @@ attr data => sub {
         # Modules to load
         modules => [qw/JSON Template/],
 
+        # Encoders
+        encoders => {
+            json => {
+                internal => {
+                    utf8 => 0,
+                },
+            },
+        },
+
         # Module initialization params
         modules_init => {
 
@@ -508,6 +517,12 @@ C<UTF-8>
 
 C<http://localhost:5000>
 
+=head2 encoders
+
+A hashref of extra encoder configs to be used by L<Kelp/get_encoder>. By
+default, only C<encoders.json.internal> is defined and disables C<utf8> flag of
+the JSON module.
+
 =head2 modules
 
 An arrayref with module names to load on startup. The default value is

lib/Kelp/Module/Encoder.pm

@@ -0,0 +1,97 @@
+package Kelp::Module::Encoder;
+
+use Kelp::Base 'Kelp::Module';
+
+attr 'args' => undef;
+attr 'encoders' => sub { {} };
+
+# need to be reimplemented
+sub encoder_name { ... }
+sub build_encoder { ... }
+
+sub build
+{
+    my ($self, %args) = @_;
+    $self->args(\%args);
+
+    $self->app->encoder_modules->{$self->encoder_name} = $self;
+}
+
+sub get_encoder_config
+{
+    my ($self, $name) = @_;
+
+    return {
+        %{$self->args},
+        %{$self->app->config(join '.', 'encoders', $self->encoder_name, $name) // {}},
+    };
+}
+
+sub get_encoder
+{
+    my ($self, $name) = @_;
+    $name //= 'default';
+
+    return $self->encoders->{$name} //=
+        $self->build_encoder($self->get_encoder_config($name));
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Kelp::Module::Encoder - Base class for encoder modules
+
+=head1 SYNOPSIS
+
+    # Writing a new encoder module
+
+    package My::Encoder;
+    use Kelp::Base 'Kelp::Encoder';
+
+    use Some::Class;
+
+    sub encoder_name { 'something' }
+    sub build_encoder {
+        my ($self, $args) = @_;
+        return Some::Class->new(%$args);
+    }
+
+    sub build {
+        my ($self, %args) = @_;
+        $self->SUPER::build(%args);
+
+        # rest of module building here if necessary
+    }
+
+    1;
+
+    # configuring a special encoder (in app's configuration)
+
+    encoders => {
+        something => {
+            modified => {
+                new_argument => 1,
+            },
+        },
+    },
+
+    # In application's code
+    # will croak if encoder was not loaded
+    # default second argument is 'default' (if not passed)
+
+    $self->get_encoder('something')->encode;
+    $self->get_encoder(something => 'modified')->decode;
+
+=head1 DESCRIPTION
+
+This is a base class for encoders which want to be compilant with the new
+L<Kelp/get_encoder> method. L</Kelp::Module::JSON> is one of such modules.
+
+This allows to have all encoders in one easy to reach spot rather than a bunch
+of unrelated methods attached to the main class. It also allows to configure a
+couple of named encoders with different config in
+L<Kelp::Module::Config/encoders> configuration of the app.
+

lib/Kelp/Module/JSON.pm

@@ -1,17 +1,23 @@
 package Kelp::Module::JSON;
 
-use Kelp::Base 'Kelp::Module';
+use Kelp::Base 'Kelp::Module::Encoder';
 
 use JSON::MaybeXS;
 
+sub encoder_name { 'json' }
+
+sub build_encoder
+{
+    my ($self, $args) = @_;
+    return JSON::MaybeXS->new(%$args);
+}
+
 sub build
 {
     my ($self, %args) = @_;
-    my $json = JSON::MaybeXS->new(%args);
-    my $json_internal = JSON::MaybeXS->new(%args, utf8 => 0);
+    $self->SUPER::build(%args);
 
-    $self->register(json => $json);
-    $self->register(_json_internal => $json_internal);
+    $self->register(json => $self->get_encoder);
 }
 
 1;
@@ -31,15 +37,20 @@ Kelp::Module::JSON - Simple JSON module for a Kelp application
         my $self = shift;
 
         # manually render a json configured to UTF-8
-        $self->res->json->set_charset('UTF-8');
+        $self->res->set_charset('UTF-8');
         $self->res->render_binary(
             $self->json->encode({ yes => 1 })
         );
     }
 
+=head1 DESCRIPTION
+
+Standard JSON encoder/decoder. Chooses the best backend through L<JSON::MaybeXS>.
+
 =head1 REGISTERED METHODS
 
-This module registers only one method into the application: C<json>.
+This module registers only one method into the application: C<json>. It also
+registers itself for later use by L<Kelp/get_encoder> under the name C<json>.
 
 The module will try to use backends in this order: I<Cpanel::JSON::XS, JSON::XS, JSON::PP>.
 
@@ -49,7 +60,7 @@ You should probably not use C<utf8>, and just encode the value into a proper
 charset by hand. You may not always want to have encoded strings anyway, for
 example some interfaces may encode the values themselves.
 
-Kelp will register a second JSON encoder / decoder with all the same options
+Kelp will use an internal copy of JSON encoder / decoder with all the same options
 but without C<utf8>, reserved for internal use. Modifying C<json> options at
 runtime will not cause the request / response encoding to change.
 

lib/Kelp/Request.pm

@@ -156,7 +156,7 @@ sub json_content
     return undef unless $self->is_json;
 
     return try {
-        $self->app->_json_internal->decode($self->content);
+        $self->app->get_encoder(json => 'internal')->decode($self->content);
     }
     catch {
         undef;

lib/Kelp/Response.pm

@@ -108,8 +108,7 @@ sub render
 
     # If the content has been determined as JSON, then encode it
     if ($ref && (!$ct || $ct =~ m{^application/json}i)) {
-        croak "No JSON encoder" unless $self->app->can('_json_internal');
-        $body = $self->app->_json_internal->encode($body);
+        $body = $self->app->get_encoder(json => 'internal')->encode($body);
         $self->json if !$ct;
     }
     elsif (!$ref) {

t/conf/encoders/test.pl

@@ -0,0 +1,17 @@
+{
+    encoders => {
+        json => {
+            indented => {
+                indent => 1,
+            },
+        },
+    },
+
+    modules_init => {
+        JSON => {
+            indent => 0,
+            space_before => 0,
+        },
+    },
+}
+

t/encoders.t

@@ -0,0 +1,29 @@
+use Kelp::Base -strict;
+
+use Kelp;
+use Test::More;
+use FindBin '$Bin';
+
+$ENV{KELP_CONFIG_DIR} = "$Bin/conf/encoders";
+my $app = Kelp->new(mode => 'test');
+
+subtest 'testing default encoder' => sub {
+    my $default_encoder = $app->get_encoder('json');
+    my $encoder = $app->get_encoder(json => 'default');
+
+    ok !$encoder->get_indent, 'encoder no indent ok';
+    is $default_encoder, $encoder, 'encoder default key is default ok';
+
+    ok !$encoder->get_space_before, 'space_before after modification ok';
+    $encoder->space_before;
+    ok $app->get_encoder('json')->get_space_before, 'space_before after modification ok';
+};
+
+subtest 'testing default encoder' => sub {
+    my $encoder = $app->get_encoder(json => 'indented');
+    ok $encoder->get_indent, 'encoder extra config ok';
+    ok !$encoder->get_space_before, 'encoder no default config ok';
+};
+
+done_testing;
+

t/request.t

@@ -1,7 +1,7 @@
 use Kelp::Base -strict;
 
 use Kelp;
-use Kelp::Test;
+use Kelp::Test -utf8;
 use HTTP::Request::Common;
 use Test::More;
 use utf8;
@@ -123,3 +123,4 @@ $t->request(POST 'via_legacy')
     ->content_is("OK");
 
 done_testing;
+