package Kelp;

use Kelp::Base;

use Carp qw/ longmess croak /;
use FindBin;
use Try::Tiny;
use Sys::Hostname;
use Plack::Util;
use Class::Inspector;
use List::Util qw(any);
use Scalar::Util qw(blessed);
use Kelp::Context;

our $VERSION = '2.11';

# Basic attributes
attr -host => hostname;
attr mode => $ENV{KELP_ENV} // $ENV{PLACK_ENV} // 'development';
attr -path => $FindBin::Bin;
attr -name => sub { (ref($_[0]) =~ /(\w+)$/) ? $1 : 'Noname' };
attr request_obj => 'Kelp::Request';
attr response_obj => 'Kelp::Response';

# Debug
attr long_error => $ENV{KELP_LONG_ERROR} // 0;

# The charset is set to UTF-8 by default in config module.
# No default here because we want to support 'undef' charset
attr charset => sub { $_[0]->config('charset') };
attr request_charset => sub { $_[0]->config('request_charset') };

# Name the config module
attr config_module => 'Config';

# Undocumented.
# Used to unlock the undocumented features of the Config module.
attr __config => undef;

attr -loaded_modules => sub { {} };

# Data for handling routes
attr context => sub { Kelp::Context->new(app => $_[0]) };
attr req => undef;
attr res => undef;

# registered application encoder modules
attr encoder_modules => sub { {} };

# Initialization
sub new
{
    my $self = shift->SUPER::new(@_);

    Kelp::Base::_DEBUG(1 => 'Loading essential modules...');

    # Always load these modules, but allow client to override
    $self->_load_config();
    $self->_load_routes();

    Kelp::Base::_DEBUG(1 => 'Loading modules from config...');

    # Load the modules from the config
    if (defined(my $modules = $self->config('modules'))) {
        $self->load_module($_) for (@$modules);
    }

    Kelp::Base::_DEBUG(1 => 'Calling build method...');

    $self->build();
    return $self;
}

sub new_anon
{
    state $last_anon = 0;
    my $class = shift;

    # make sure we don't eval something dodgy
    die "invalid class for new_anon"
        if ref $class    # not a string
        || !$class    # not an empty string, undef or 0
        || !Class::Inspector->loaded($class)    # not a loaded class
        || !$class->isa(__PACKAGE__)    # not a correct class
        ;

    my $anon_class = "Kelp::Anonymous::$class" . ++$last_anon;
    my $err = do {
        local $@;
        my $eval_status = eval qq[
            {
                package $anon_class;
                use parent -norequire, '$class';

                sub _real_class { '$class' }
            }
            1;
        ];
        $@ || !$eval_status;
    };

    if ($err) {
        die "Couldn't create anonymous Kelp instance: " .
            (length $err > 1 ? $err : 'unknown error');
    }

    return $anon_class->new(@_);
}

sub _load_config
{
    my $self = shift;
    $self->load_module($self->config_module, extra => $self->__config);

    Kelp::Base::_DEBUG(config => 'Merged configuration: ', $self->config_hash);
}

sub _load_routes
{
    my $self = shift;
    $self->load_module('Routes');
}

# Create a shallow copy of the app, optionally blessed into a
# different subclass.
sub _clone
{
    my $self = shift;
    my $subclass = shift || ref($self);

    ref $self or croak '_clone requires instance';
    return bless {%$self}, $subclass;
}

sub load_module
{
    my ($self, $name, %args) = @_;

    # A module name with a leading + indicates it's already fully
    # qualified (i.e., it does not need the Kelp::Module:: prefix).
    my $prefix = $name =~ s/^\+// ? undef : 'Kelp::Module';

    # Make sure the module was not already loaded
    return if $self->loaded_modules->{$name};

    my $class = Plack::Util::load_class($name, $prefix);
    my $module = $self->loaded_modules->{$name} = $class->new(app => $self);

    # When loading the Config module itself, we don't have
    # access to $self->config yet. This is why we check if
    # config is available, and if it is, then we pull the
    # initialization hash.
    my $args_from_config = {};
    if ($self->can('config')) {
        $args_from_config = $self->config("modules_init.$name") // {};
    }

    Kelp::Base::_DEBUG(modules => "Loading $class module with args: ", {%$args_from_config, %args});

    $module->build(%$args_from_config, %args);
    return $module;
}

# Override this one to add custom initializations
sub build
{
}

# Override to use a custom request object
sub build_request
{
    return Kelp::Util::load_package($_[0]->request_obj)->new(
        app => $_[0],
        env => $_[1],
    );
}

# Override to use a custom response object
sub build_response
{
    return Kelp::Util::load_package($_[0]->response_obj)->new(
        app => $_[0],
    );
}

# Override to change what happens before the route is handled
sub before_dispatch
{
    my ($self, $destination) = @_;

    # Log info about the route
    if ($self->can('logger')) {
        my $req = $self->req;

        $self->info(
            sprintf "%s: %s - %s %s - %s",
            ref $self,
            $req->address, $req->method,
            $req->path, $destination
        );
    }
}

# Override to manipulate the end response
sub before_finalize
{
    my $self = shift;
    $self->res->header('X-Framework' => 'Perl Kelp');
}

# Override this to wrap more middleware around the app
sub run
{
    my $self = shift;
    my $app = sub { $self->psgi(@_) };

    Kelp::Base::_DEBUG(1 => 'Running the application...');

    # Add middleware
    if (defined(my $middleware = $self->config('middleware'))) {
        for my $class (@$middleware) {

            # Make sure the middleware was not already loaded
            # This does not apply for testing, in which case we want
            # the middleware to wrap every single time
            next if $self->{_loaded_middleware}->{$class}++ && !$ENV{KELP_TESTING};

            my $mw = Plack::Util::load_class($class, 'Plack::Middleware');
            my $args = $self->config("middleware_init.$class") // {};

            Kelp::Base::_DEBUG(modules => "Wrapping app in $mw middleware with args: ", $args);

            $app = $mw->wrap($app, %$args);
        }
    }

    return $app;
}

sub psgi
{
    my ($self, $env) = @_;

    # Initialize the app object state
    $self->context->clear;
    my $req = $self->req($self->build_request($env));
    my $res = $self->res($self->build_response);

    # Get route matches
    my $match = $self->routes->match($req->path, $req->method);

    # None found? Short-circuit and show 404
    if (!@$match) {
        $res->render_404;
        return $self->finalize;
    }

    return try {

        # Go over the entire route chain
        for my $route (@$match) {

            # Dispatch
            $req->named($route->named);
            $req->route_name($route->name);
            my $data = $self->routes->dispatch($self, $route);

            if ($route->bridge) {

                # Is it a bridge? Bridges must return a true value to allow the
                # rest of the routes to run. They may also have rendered
                # something, in which case trust that and don't render 403 (but
                # still end the execution chain)

                if (!$data) {
                    $res->render_403 unless $res->rendered;
                }
            }
            elsif (defined $data) {

                # If the non-bridge route returned something, then analyze it and render it

                # Handle delayed response if CODE
                return $data if ref $data eq 'CODE';
                $res->render($data) unless $res->rendered;
            }

            # Do not go any further if we got a render
            last if $res->rendered;
        }

        # If nothing got rendered
        if (!$res->rendered) {

            # render 404 if only briges matched
            if ($match->[-1]->bridge) {
                $res->render_404;
            }

            # or die with error
            else {
                die $match->[-1]->to
                    . " did not render for method "
                    . $req->method;
            }
        }

        return $self->finalize;
    }
    catch {
        my $exception = $_;

        # CONTEXT CHANGE: we need to clear response state because anything that
        # was rendered beforehand is no longer valid. Body and code will be
        # replaced automatically with render methods, but headers must be
        # cleared explicitly
        $res->headers->clear;

        if (blessed $exception && $exception->isa('Kelp::Exception')) {

            # only log it as an error if the body is present
            $self->logger('error', $exception->body)
                if $self->can('logger') && defined $exception->body;

            $res->render_exception($exception);
        }
        else {
            my $message = $self->long_error ? longmess($exception) : $exception;

            # Log error
            $self->logger('critical', $message) if $self->can('logger');

            # Render an application erorr (hides details on production)
            $res->render_500($exception);
        }

        return $self->finalize;
    };
}

sub finalize
{
    my $self = shift;

    # call it with current context, so that it will get controller's hook if
    # possible
    $self->context->current->before_finalize;

    return $self->res->finalize;
}

#----------------------------------------------------------------
# Request and Response shortcuts
#----------------------------------------------------------------
sub param
{
    my $self = shift;
    unshift @_, $self->req;

    # goto will allow carp show the correct caller
    goto $_[0]->can('param');
}

sub session { shift->req->session(@_) }

sub stash
{
    my $self = shift;
    @_ ? $self->req->stash->{$_[0]} : $self->req->stash;
}

sub named
{
    my $self = shift;
    @_ ? $self->req->named->{$_[0]} : $self->req->named;
}

#----------------------------------------------------------------
# Utility
#----------------------------------------------------------------

sub is_production
{
    my $self = shift;
    return any { lc $self->mode eq $_ } qw(deployment production);
}

sub url_for
{
    my ($self, $name, @args) = @_;
    my $result = $name;
    try { $result = $self->routes->url($name, @args) };
    return $result;
}

sub abs_url
{
    my ($self, $name, @args) = @_;
    my $url = $self->url_for($name, @args);
    return URI->new_abs($url, $self->config('app_url'))->as_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__

=pod

=head1 NAME

Kelp - A web framework light, yet rich in nutrients.

=head1 SYNOPSIS

    package MyApp;
    use parent 'Kelp';

    # bootstrap your application
    sub build {
        my ($self) = @_;

        my $r = $self->routes;

        $r->add('/simple/route', 'route_handler');
        $r->add('/route/:name', {
            to => 'namespace::controller::action',
            ... # other options, see Kelp::Routes
        });
    }

    # example route handler
    sub route_handler {
        my ($kelp_instance, @route_parameters) = @_;

        return 'text to be rendered';
    }

    1;

=head1 DESCRIPTION

Kelp is a light, modular web framework built on top of Plack.

This document lists all the methods and attributes available in the main
instance of a Kelp application, passed as a first argument to route handling
routines. If you're just getting started, you may be more interested in the
following documentation pages:

See L<Kelp::Manual> for a complete reference.

See L<Kelp::Manual::Cookbook> for solutions to common problems.

=head1 REASONS TO USE KELP

=over

=item

B<Plack ecosystem>. Kelp isn't just compatible with L<Plack>, it's built on top
of it. Your application can be supported by a collection of already available Plack
components.

=item

B<Advanced Routing>. Create intricate, yet simple ways to capture HTTP requests
and route them to their designated code. Use explicit and optional named
placeholders, wildcards, or just regular expressions.

=item

B<Flexible Configuration>. Use different configuration file for each
environment, e.g. development, deployment, etc. Merge a temporary configuration
into your current one for testing and debugging purposes.

=item

B<Enhanced Logging>. Log messages at different levels of emergency. Log to a
file, screen, or anything supported by L<Log::Dispatch>.

=item

B<Powerful Rendering>. Use the built-in auto-rendering logic, or the template
module of your choice to return rich text, html and JSON responses.

=item

B<JSON encoder/decoder>. Kelp can handle JSON-formatted requests and responses
automatically, making working with JSON much more enjoyable. On top of that, it
uses L<JSON::MaybeXS> to choose the best (fastest, most secure) backend
available.

=item

B<Extendable Core>. Kelp has straightforward code and uses pluggable modules
for everything. This allows anyone to extend it or add a module for a custom
interface. Writing Kelp modules is easy.

=item

B<Sleek Testing>. Kelp takes Plack::Test and wraps it in an object oriented
class of convenience methods. Testing is done via sending requests to your
routes, then analyzing the response.

=back

=head1 ATTRIBUTES

=head2 hostname

Gets the current hostname.

    sub some_route {
        my $self = shift;
        if ( $self->hostname eq 'prod-host' ) {
            ...
        }
    }

=head2 mode

Sets or gets the current mode. The mode is important for the app to know what
configuration file to merge into the main configuration. See
L<Kelp::Module::Config> for more information.

    my $app = MyApp->new( mode => 'development' );
    # conf/config.pl and conf/development.pl are merged with priority
    # given to the second one.

=head2 request_obj

Provide a custom package name to define the global ::Request object. Defaults to
L<Kelp::Request>.

=head2 response_obj

Provide a custom package name to define the global ::Response object. Defaults to
L<Kelp::Response>.

=head2 config_module

Sets of gets the class of the configuration module to be loaded on startup. The
default value is C<Config>, which will cause the C<Kelp::Module::Config> to get
loaded. See the documentation for L<Kelp::Module::Config> for more information
and for an example of how to create and use other config modules.

=head2 loaded_modules

A hashref containing the names and instances of all loaded modules. For example,
if you have these two modules loaded: Template and JSON, then a dump of
the C<loaded_modules> hash will look like this:

    {
        Template => Kelp::Module::Template=HASH(0x208f6e8),
        JSON     => Kelp::Module::JSON=HASH(0x209d454)
    }

This can come in handy if your module does more than just registering a new method
into the application. Then, you can use its object instance to access that
additional functionality.


=head2 path

Gets the current path of the application. That would be the path to C<app.psgi>

=head2 name

Gets or sets the name of the application. If not set, the name of the main
class will be used.

    my $app = MyApp->new( name => 'Twittar' );

=head2 charset

Gets or sets the output encoding charset of the app. It will be C<UTF-8>, if
not set to anything else. The charset can also changed in the config files.

If the charset is explicitly configured to be C<undef> or false, the
application won't do any automatic encoding of responses, unless you set it by
explicitly calling L<Kelp::Response/charset>.

=head2 request_charset

Same as L</charset>, but only applies to the input. Request data will be
decoded using this charset or charset which came with the request.

If the request charset is explicitly configured to be C<undef> or false, the
application won't do any automatic decoding of requests, B<even if message came
with a charset>.

For details, see L<Kelp::Request/ENCODING>.

=head2 long_error

When a route dies, Kelp will by default display a short error message. Set this
attribute to a true value if you need to see a full stack trace of the error.
The C<KELP_LONG_ERROR> environment variable can also set this attribute.

=head2 req

This attribute only makes sense if called within a route definition. It will
contain a reference to the current L<Kelp::Request> instance.

    sub some_route {
        my $self = shift;
        if ( $self->req->is_json ) {
            ...
        }
    }


=head2 res

This attribute only makes sense if called within a route definition. It will
contain a reference to the current L<Kelp::Response> instance.

    sub some_route {
        my $self = shift;
        $self->res->json->render( { success => 1 } );
    }

=head2 context

This holds application's context. Its usage is advanced and only useful for
controller logic, but may allow for some introspection into Kelp.

For example, if you have a route in a controller and need to get the original
Kelp app object, you may call this:

    sub some_route {
        my $controller = shift;
        my $app = $controller->context->app;
    }

=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

    my $the_only_kelp = KelpApp->new;

A standard constructor. B<Cannot> be called multiple times: see L</new_anon>.

=head2 new_anon

    my $kelp1 = KelpApp->new_anon(config => 'conf1');
    my $kelp2 = KelpApp->new_anon(config => 'conf2');

A constructor that can be called repeatedly. Cannot be mixed with L</new>.

It works by creating a new anonymous class extending the class of your
application and running I<new> on it. C<ref $kelp> will return I<something
else> than the name of your Kelp class, but C<< $kelp->isa('KelpApp') >> will
be true. This will likely be useful during testing or when running multiple
instances of the same application with different configurations.

=head2 build

On its own, the C<build> method doesn't do anything. It is called by the
constructor, so it can be overridden to add route destinations and
initializations.

    package MyApp;

    sub build {
        my $self = shift;
        my $r = $self->routes;

        # Load some modules
        $self->load_module("MongoDB");
        $self->load_module("Validate");

        # Add all route destinations
        $r->add("/one", "one");
        ...

    }

=head2 load_module

C<load_module($name, %options)>

Used to load a module. All modules must be under the C<Kelp::Module::>
namespace.

    $self->load_module("Redis", server => '127.0.0.1');
    # Will look for and load Kelp::Module::Redis

Options for the module may be specified after its name, or in the
C<modules_init> hash in the config. Precedence is given to the
inline options.
See L<Kelp::Module> for more information on making and using modules.

=head2 build_request

This method is used to create the request object for each HTTP request. It
returns an instance of the class defined in the request_obj attribute (defaults to
L<Kelp::Request>), initialized with the current request's environment. You can
override this method to use a custom request module if you need to do something
interesting. Though there is a provided attribute that can be used to overide
the class of the object used.

    package MyApp;
    use MyApp::Request;

    sub build_request {
        my ( $self, $env ) = @_;
        return MyApp::Request->new( app => $app, env => $env );
    }

    # Now each request will be handled by MyApp::Request

=head2 before_dispatch

Override this method to modify the behavior before a route is handled. The
default behavior is to log access (if C<logger> is available).

    package MyApp;

    sub before_dispatch {
        my ( $self, $destination ) = @_;

        # default access logging is disabled
    }

The C<$destination> param will depend on the routes implementation used. The
default router will pass the unchanged L<Kelp::Routes::Pattern/to>. If
possible, it will be run on the controller object (allowing overriding
C<before_dispatch> on controller classes).


=head2 before_finalize

Override this method to modify the response object just before it gets
finalized.

    package MyApp;

    sub before_finalize {
        my $self = shift;
        $self->res->set_header("X-App-Name", "MyApp");
    }

    ...

The above is an example of how to insert a custom header into the response of
every route.

=head2 build_response

This method creates the response object, e.g. what an HTTP request will return.
By default the object created is L<Kelp::Response> though this can be
overwritten via the respone_obj attribute. Much like L</build_request>, the
response can also be overridden to use a custom response object if you need
something completely custom.

=head2 run

This method builds and returns the PSGI app. You can override it in order to
include middleware. See L<Kelp::Manual/Adding middleware> for an example.

=head2 param

A shortcut to C<$self-E<gt>req-E<gt>param>:

    sub some_route {
        my $self = shift;
        if ( $self->param('age') > 18 ) {
            $self->can_watch_south_path(1);
        }
    }

This function can be tricky to use because of context sensivity. See
L<Kelp::Request/param> for more information and examples.

=head2 session

A shortcut to C<$self-E<gt>req-E<gt>session>. Take a look at L<Kelp::Request/session>
for more information and examples.

=head2 stash

Provides safe access to C<$self-E<gt>req-E<gt>stash>. When called without
arguments, it will return the stash hash. If called with a single argument, it
will return the value of the corresponding key in the stash.
See L<Kelp::Request/stash> for more information and examples.

=head2 named

Provides safe access to C<$self-E<gt>req-E<gt>named>. When called without
arguments, it will return the named hash. If called with a single argument, it
will return the value of the corresponding key in the named hash.
See L<Kelp::Request/named> for more information and examples.

=head2 url_for

A safe shortcut to C<$self-E<gt>routes-E<gt>url>. Builds a URL from path and
arguments.

    sub build {
        my $self = shift;
        $self->routes->add("/:name/:id", { name => 'name', to => sub {
            ...
        }});
    }

    sub check {
        my $self = shift;
        my $url_for_name = $self->url_for('name', name => 'jake', id => 1003);
        $self->res->redirect_to( $url_for_name );
    }

=head2 abs_url

Same as L</url_for>, but returns the full absolute URI for the current
application (based on configuration).

=head2 is_production

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.

Example new JSON encoder type defined in config:

    encoders => {
        json => {
            not_very_pretty => {
                pretty => 0,
            },
        },
    },

=head1 AUTHOR

Stefan Geneshky - minimal <at> cpan.org

=head1 LICENSE

This module and all the modules in this package are governed by the same license
as Perl itself.

=cut

