package MVC::Neaf;

use 5.006;
use strict;
use warnings;

our $VERSION = 0.13;

=head1 NAME

MVC::Neaf - Not Even A Framework for very simple web apps.

=head1 OVERVIEW

Neaf [ni:f] stands for Not Even An (MVC) Framework.

It is made for lazy people without an IDE.

The Model is assumed to be just a regular Perl module,
no restrictions are imposed on it.

The View is an object with one method, C<render>, receiving a hashref
and returning rendered content as string plus optional content-type header.

The Controller is reduced to just one function which receives
a <MVC::Neaf::Request> object containing all it needs to know
and returns a simple \%hashref which is forwarded to View.

Multiple controllers can be set up in the same application
under different paths.

Please see the examples directory in this distribution
which demonstrates the features of Neaf.

=head1 SYNOPSIS

The following application, outputting a greeting, is ready to run
as a CGI script, PSGI application, or Apache handler.

    use MVC::Neaf;

    MVC::Neaf->route( "/app" => sub {
        my $req = shift;

        my $name = $req->param( name => qr/[\w\s]+/, "Yet another perl hacker" );

        return {
            -template => \"Hello, [% name %]",
            -type     => "text/plain",
            name      => $name,
        };
    });
    MVC::Neaf->run;

=head1 CREATING AN APPLICATION

=head2 THE CONTROLLER

The Controller sub receives an L<MVC::Neaf::Request> object
and outputs a \%hashref.

It may also die, which will be interpreted as an error 500,
UNLESS error message starts with 3 digits and a whitespace,
in which case this is considered the return status.
E.g. die 404; is a valid method to return "Not Found" right away.

Much like in L<Dancer> or L<Kelp>, multiple controllers may be configured
under different paths using the C<route( path =E<gt> CODEREF );>
method discussed below.

=head2 THE REQUEST

B<The Request> object is similar to the OO interface of L<CGI>
or L<Plack::Request> with some minor differences:

    # What was requested:
    http(s)://server.name:1337/mathing/route/some/more/slashes?foo=1&bar=2

    # What is being returned:
    $req->http_version; # = HTTP/1.0 or HTTP/1.1
    $req->scheme      ; # = http or https
    $req->method      ; # = GET
    $req->hostname    ; # = server.name
    $req->port        ; # = 1337
    $req->path        ; # = /mathing/route/some/more/slashes
    $req->script_name ; # = /mathing/route
    $req->path_info   ; # = /some/more/slashes

    $req->param( foo => '\d+' ); # = 1
    $req->get_cookie( session => '.+' ); # = whatever it was set to before

One I<major> difference is that there's no (easy) way to fetch
query parameters or cookies without validation.
Just use qr/.*/ if you know better.

Also there are some methods that affect the reply,
mainly the headers, like C<set_cookie> or C<redirect>.
This is a step towards a know-it-all God object,
however, mapping those proverties into a hashref turned out to be
too cumbersome.

=head2 THE RESPONSE

B<The response> may contain regular keys, typically alphanumeric,
as well as a predefined set of dash-prefixed keys which control
app's behaviour.

I<-Note -that -dash-prefixed -options -look -antique
even to the author of this writing.
They smell like Tk and CGI. They feel so 90's!
However, it looks like a meaningful and B<visible> way to separate
auxiliary parameters from users's data,
without requiring a more complex return structure
(two hashes, array of arrays etc).>

The small but growing list of these -options is as follows:

=over

=item * -content - Return raw data and skip view processing.
E.g. display generated image.

=item * -continue - A callback which receives the Request object.
It will be executed after the headers and pre-generated content
are served to the client, and may use $req->write( $data )
and $req->close to write more data.

=item * -jsonp - Used by JS view module as a callback name to produce a
L<jsonp|https://en.wikipedia.org/wiki/JSONP> response.
Callback is ignored unless it is a set of identifiers separated by dots,
for security reasons.

=item * -location - HTTP Location: header.

=item * -status - HTTP status (200, 404, 500 etc).
Default is 200 if the app managed to live through, and 500 if it died.

=item * -template - Set template name for TT (L<Template>-based view).

=item * -type - Content-type HTTP header.
View module may set this parameter if unset.
Default: C<"text/html">.

=item * -view - select B<View> module.
Views are initialized lazily and cached by the framework.
C<TT>, C<JS>, C<Full::Module::Name>, and C<$view_predefined_object>
are currently supported.
New short aliases may be created by
C<MVC::Neaf-E<gt>load_view( "name" => $your_view );>. (See below).

=back

Though more dash-prefixed parameters may be returned
and will be passed to the View module as of current,
they are not guaranteed to work in the future.
Please either avoid them, or send patches.

=head1 APPLICATION API

These methods are generally called during the setup phase of the application.
They have nothing to do with serving the request.

=cut

use Carp;
use Scalar::Util qw(blessed looks_like_number);
use Encode;
use POSIX qw(strftime);
use parent qw(Exporter);

our @EXPORT_OK = qw(neaf_err);

use MVC::Neaf::Request;

our $Inst = __PACKAGE__->new;

=head2 route( path => CODEREF, %options )

Set up an URI handler in the application.
Any incoming request to uri matching C</path>
(C</path/something/else> too, but NOT C</pathology>)
will now be directed to CODEREF.

Longer paths are GUARANTEED to be checked first.

Dies if the same method and path combo is given again.
Multiple methods may be given for the same path,
e.g. when handling REST.

Exactly one leading slash will be prepended no matter what you do.
(C<path>, C</path> and C</////path> are all the same).

%options may include:

=over

=item * method - list of allowed HTTP methods.
Default is [GET, POST, HEAD].
Multiple handles can be defined for the same path, provided that
metyhods do not intersect.

=item * path_info_regex => qr/.../ - allow URI subpaths matching
the specified expression to be handled by this handler.

If specified, 404 error will be returned unless PATH_INFO matches the regex
(without the leading slash).

Starting from v.0.16, this parameter is going to be REQUIRED for path_info()
method to be used in the handler.
Until then, a DEPRECATED warning will be generated for a naked path_info call.

B<EXPERIMENTAL>. Name and semantics MAY change in the future.

=item * view - default View object for this Controller.
Must be an object with a C<render> methods, or a CODEREF
receiving hash and returning a list of two scalars.

=item * cache_ttl - if set, set Expires: HTTP header accordingly.

B<EXPERIMENTAL>. Name and semantics MAY change in the future.

=item * description - just for information, has no action on execution.
This will be displayed if application called with --list (see L<MVC::Neaf::CLI>).

=back

=cut

my $year = 365 * 24 * 60 * 60;
sub route {
    my $self = shift;

    # HACK!! pack path components together, i.e.
    # foo => bar => \&handle eq "/foo/bar" => \&handle
    my ( $path, $sub );
    while ($sub = shift) {
        last if ref $sub;
        $path .= "/$sub";
    };
    $self->_croak( "Odd number of elements in hash assignment" )
        if @_ % 2;
    my (%args) = @_;
    $self = $Inst unless ref $self;

    # Sanitize path so that we have exactly one leading slash
    # root becomes nothing (which is OK with us).
    $path =~ s#^/*#/#;
    $path =~ s#/+$##;

    $args{method} ||= [qw[ GET POST HEAD ]];
    $args{method} = [ $args{method} ] unless ref $args{method} eq 'ARRAY';

    my @dupe = grep { exists $self->{route}{$path}{$_} } @{ $args{method} };
    $self->_croak( "Attempting to set duplicate handler for [@dupe] "
        .( length $path ? $path : "/" ) )
            if @dupe;

    # Do the work
    my %profile;
    $profile{code}     = $sub;
    $profile{caller}   = [caller(0)]; # file,line
    if ( !defined $args{path_info_regex} ) {
        # TODO replace def path_info_regex with '' in v.0.16 aka '404 if unspecified'
        $args{path_info_regex}      = '.*';
    } else {
        $profile{has_path_info_regex} = 1;
    };
    $profile{path_info_regex_regex}  = qr#^/*($args{path_info_regex})$#;

    # Just for information
    $profile{path}        = $path;
    $profile{description} = $args{description};

    if (my $view = $args{view}) {
        if (!ref $view) {
            $view = $self->load_view( $view );
        } elsif (ref $view eq 'CODE') {
            $view = MVC::Neaf::View->new( on_render => $view );
        };

        $self->_croak( "view must be a coderef or a MVC::Neaf::View object" )
            unless blessed $view and $view->isa("MVC::Neaf::View");

        $profile{view} = $view;
    };

    if ( $args{cache_ttl} ) {
        $self->_croak("cache_ttl must be a number")
            unless looks_like_number($args{cache_ttl});
        # as required by RFC
        $args{cache_ttl} = -100000 if $args{cache_ttl} < 0;
        $args{cache_ttl} = $year if $args{cache_ttl} > $year;
        $profile{cache_ttl} = $args{cache_ttl};
    };

    # ready, install handler & burn cache
    delete $self->{route_re};
    $self->{route}{ $path }{$_} = \%profile
        for @{ $args{method} };

    return $self;
}; # end sub route

=head2 alias( $newpath => $oldpath )

Create a new name for already registered route.
The handler will be executed as is,
but new name will be reflected in Request->path.

Returns self.

=cut

sub alias {
    my ($self, $new, $old) = @_;
    $self = $Inst unless ref $self;

    $old =~ s#^/*#/#;
    $old =~ s#/+$##;

    $self->{route}{$old}
        or $self->_croak( "Cannot create alias for unknown route $old" );

    # The same sanitizing as in route
    $new =~ s#^/*#/#;
    $new =~ s#/+$##;
    $self->_croak( "Attempting to set duplicate handler for path "
        .( length $new ? $new : "/" ) )
            if $self->{route}{ $new };

    # reset cache
    $self->{route_re} = undef;

    $self->{route}{$new} = $self->{route}{$old};
    return $self;
};

=head2 static( $req_path => $file_path, %options )

Serve static content located under $file_path.

File type detection is based on extention.
This MAY change in the future.
Known file types are listed in %MVC::Neaf::X::Files::ExtType hash.
Patches welcome.

%options may include:

=over

=item * buffer => nnn - buffer size for reading/writing files.
Default is 4096. Smaller values may be set, but are NOT recommended.

=item * cache_ttl => nnn - if given, files below the buffer size will be stored
in memory for cache_ttl seconds.

B<EXPERIMENTAL>. Cache API is not yet established.

=item * allow_dots => 1|0 - if true, serve files/directories
starting with a dot (.git etc), otherwise give a 404.

B<EXPERIMAENTAL>

=item * description - comment. The default is "Static content at $dir"

=back

Generally it is probably a bad idea to serve files in production
using a web application framework.
Use a real web server instead.

However, this method may come in handy when testing the application
in standalone mode, e.g. under plack web server.
This is the intended usage.

=cut

my %static_options;
$static_options{$_}++ for qw( description buffer cache_ttl allow_dots );
sub static {
    my ($self, $path, $dir, %options) = @_;
    $self = $Inst unless ref $self;

    my @extra = grep { !$static_options{$_} } keys %options;
    $self->_croak( "Unknown options @extra" )
        if @extra;

    require MVC::Neaf::X::Files;
    my $xfiles = MVC::Neaf::X::Files->new( %options, root => $dir );
    return $self->route($path => $xfiles->make_handler
        , method => ['GET', 'HEAD']
        , path_info_regex => '.*'
        , cache_ttl => $options{cache_ttl}
        , description => $options{description} || "Static content at $dir" );
};

=head2 pre_route( sub { ... } )

Mangle request before serving it.
E.g. canonize uri or read session cookie.

Return value from callback is ignored.

Dying in callback is treated the same way as in normal controller sub.

=cut

sub pre_route {
    my ($self, $code) = @_;
    $self = $Inst unless ref $self;

    $self->{pre_route} = $code;
    return $self;
};

=head2 load_view( $view_name, [ $object || $module_name, %options ] )

Return a cached View object named $view_name.
This will be called whenever the app returns { -view => "foo" }.

If no such object was found, attempts to add new object to cache:

=over

=item * if object is given, just saves it.

=item * if module name + parameters is given, tries to load module
and create new() instance.

=item * as a last resort, loads stock view: C<TT>, C<JS>, or C<Dumper>.
Those are prefixed with C<MVC::Neaf::View::>.

=back

If set_forced_view was called with an argument,
return THAT view instance instead of all above.

So the intended usage is as follows:

    # in the app initialisation section
    # this can be omitted when using TT, JS, or Dumper as view.
    MVC::Neaf->load_view( foo => TT, INCLUDE_PATH => "/foo/bar" );
        # Short alias for MVC::Neaf::View::TT

    # in the app itself
    return {
        ...
        -view => "foo", # triggers a second call with 1 parameter "foo"
    };

B<NOTE> Some convoluted logic here, needs rework.

=cut

my %known_view = (
    TT     => 'MVC::Neaf::View::TT',
    JS     => 'MVC::Neaf::View::JS',
    Dumper => 'MVC::Neaf::View::Dumper',
);
sub load_view {
    my ($self, $view, $module, @param) = @_;
    $self = $Inst unless ref $self;

    return $self->{force_view}
        if exists $self->{force_view};
    $view = $self->{-view}
        unless defined $view;

    # Already an object - just return it after the checks
    return $view if ref $view;
    # Agressive caching FTW!
    return $self->{seen_view}{$view}
        if exists $self->{seen_view}{$view};

    # If we got to this point, we don't have $view cached just yet.
    # Instantiate and save!

    if (!ref $module) {
        # If 1-arg call is used, try using view name as class name
        $module ||= $view;
        # in case an alias is used, apply alias
        $module = $known_view{ $module } || $module;

        # Try loading...
        eval "require $module"; ## no critic
        $self->_croak( "Failed to load view $view: $@" )
            if $@;
        $module = $module->new( @param );
    };

    $self->{seen_view}{$view} = $module;

    return $module;
};

=head2 set_default ( key => value, ... )

Set some default values that would be appended to data hash returned
from any controller on successful operation.
Controller return always overrides these values.

Returns self.

=cut

sub set_default {
    my ($self, %data) = @_;
    $self = $Inst unless ref $self;

    $self->{defaults}{$_} = $data{$_} for keys %data;
    return $self;
};

=head2 set_session_handler( %options )

Set a handler for managing sessions.

If such handler is set, the request object will provide session(),
save_session(), and delete_session() methods to manage
cross-request user data.

% options may include:

=over

=item * engine (required) - an object providing the storage primitives;

=item * ttl - time to live for session (default is 0, which means until
browser is closed);

=item * cookie - name of cookie storing session id.
The default is "session".

=item * view_as - if set, add the whole session into data hash
under this name before view processing.

=back

The engine MUST provide the following methods
(see L<MVC::Neaf::X::Session> for details):

=over

=item * session_ttl (implemented in MVC::Neaf::X::Session);

=item * session_id_regex (implemented in MVC::Neaf::X::Session);

=item * get_session_id (implemented in MVC::Neaf::X::Session);

=item * create_session (implemented in MVC::Neaf::X::Session);

=item * save_session (required);

=item * load_session (required);

=item * delete_session (implemented in MVC::Neaf::X::Session);

=back

=cut

sub set_session_handler {
    my ($self, %opt) = @_;
    $self = $Inst unless ref $self;

    my $sess = $opt{engine};
    my $cook = $opt{cookie} || 'session';

    $self->_croak("engine parameter is required")
        unless $sess;
    my @missing = grep { !$sess->can($_) }
        qw(get_session_id session_id_regex session_ttl
            create_session load_session save_session delete_session );
    $self->_croak("engine object does not have methods: @missing")
        if @missing;

    my $regex = $sess->session_id_regex || qr(^$);
    my $ttl   = $opt{ttl} || $sess->session_ttl || 0;

    $self->{session_handler} = [ $sess, $cook, $regex, $ttl ];
    $self->{session_view_as} = $opt{view_as};
    return $self;
};

=head2 set_error_handler ( status => CODEREF( $req, %options ) )

Set custom error handler.

Status must be either a 3-digit number (as in HTTP), or "view".
Other allowed keys MAY appear in the future.

The following options will be passed to coderef:

=over

=item * status - status being returned (500 in case of 'view');

=item * caller - array with the point where MVC::Neaf->route was set up;

=item * error - exception, if there was one.

=back

The coderef MUST return an unblessed hash just like controller does.

In case of exception or unexpected return format text message "Error XXX"
will be returned instead.

=head2 set_error_handler ( status => \%hash )

Return a static template as { %options, %hash }.

=cut

sub set_error_handler {
    my ($self, $status, $code) = @_;
    $self = $Inst unless ref $self;

    $status =~ /^(\d\d\d|view)$/
        or $self->_croak( "1st arg must be http status or a const(see docs)");
    if (ref $code eq 'HASH') {
        my $hash = $code;
        $code = sub {
            my ($req, %opt) = @_;

            return { -status => $opt{status}, %opt, %$hash };
        };
    };
    ref $code eq 'CODE'
        or $self->_croak( "2nd arg must be callback or hash");

    $self->{error_template}{$status} = $code;

    return $self;
};

=head2 error_template( ... )

B<DEPRECATED>. Same as above, but issues a warning.

=cut

sub error_template {
    my $self = shift;

    carp "error_template() is deprecated, use set_error_handler() instead";
    return $self->set_error_handler(@_);
};

=head2 on_error( sub { my ($req, $err) = @_ } )

Install custom error handler for dying controller.
Neaf's own exceptions and 'die \d\d\d' status returns will NOT
trigger it.

E.g. write to log, or something.

Return value from this callback is ignored.
If it dies, only a warning is emitted.

=cut

sub on_error {
    my ($self, $code) = @_;
    $self = $Inst unless ref $self;

    if (defined $code) {
        ref $code eq 'CODE'
            or $self->_croak( "Argument MUST be a callback" );
        $self->{on_error} = $code;
    } else {
        delete $self->{on_error};
    };

    return $self;
};

=head2 run()

Run the applicaton.
This should be in the last statement in your appication main file.

If called in void context, assumes CGI is being used and instantiates
L<MVC::Neaf::Request::CGI>.
If command line options are present at the time,
enters debug mode via L<MVC::Neaf::CLI>.

Otherwise returns a PSGI-compliant coderef.
This will also happen if you application is C<require>'d,
meaning that it returns a true value and actually serves nothing until
run() is called again.

Running under mod_perl requires setting a handler with
L<MVC::Neaf::Request::Apache2>.

=cut

sub run {
    my $self = shift;
    $self = $Inst unless ref $self;

    $self->{route_re} ||= $self->_make_route_re;

    if (defined wantarray) {
        # The run method is being called in non-void context
        # This is the case for PSGI, but not CGI (where it's just
        # the last statement in the script).

        # PSGI
        require MVC::Neaf::Request::PSGI;
        return sub {
            my $env = shift;
            my $req = MVC::Neaf::Request::PSGI->new( env => $env );
            return $self->handle_request( $req );
        };
    } else {
        # void context - CGI called.
        require MVC::Neaf::Request::CGI;

        if (@ARGV) {
            require MVC::Neaf::CLI;
            MVC::Neaf::CLI->run;
        } else {;
            my $req = MVC::Neaf::Request::CGI->new;
            $self->handle_request( $req );
        };
    };
};

sub _make_route_re {
    my ($self, $hash) = @_;

    $hash ||= $self->{route};

    my $re = join "|", map { quotemeta } reverse sort keys %$hash;

    # make $1, $2 always defined
    return qr{^($re)((?:/[^?]*)?)(?:\?|$)};
};

=head1 EXPORTED FUNCTIONS

Currently only one function is exportable:

=head2 neaf_err $error

Rethrow Neaf's internal exceptions immediately, do nothing otherwise.

If no argument if given, acts on current $@ value.

Currently Neaf uses exception mechanism for internal signalling,
so this function may be of use if there's a lot of eval blocks
in the controller. E.g.

    use MVC::Neaf qw(neaf_err);

    # somewhere in controller
    eval {
        check_permissions()
            or $req->error(403);
        do_something()
            and $req->redirect("/success");
    };

    if (my $err = $@) {
        neaf_err;
        # do the rest of error handling
    };

=cut

sub neaf_err(;$) { ## no critic # prototype it for less typing on user's part
    my $err = shift || $@;
    return unless blessed $err and $err->isa("MVC::Neaf::Exception");
    die $err;
};

=head1 DEVELOPMENT AND DEBUGGING METHODS

=head2 get_routes

Returns a hash with ALL routes for inspection.
This should NOT be used by application itself.

=cut

sub get_routes {
    my $self = shift;
    $self = $Inst unless ref $self;

    # shallow copy TODO need 2 layers!
    return { %{ $self->{route} } };
};

=head2 set_forced_view( $view )

If set, this view object will be user instead of ANY other view.

See C<load_view>.

Returns self.

=cut

sub set_forced_view {
    my ($self, $view) = @_;
    $self = $Inst unless ref $self;

    delete $self->{force_view};
    return $self unless $view;

    $self->{force_view} = $self->load_view( $view );

    return $self;
};

=head2 server_stat ( MVC::Neaf::X::ServerStat->new( ... ) )

Record server performance statistics during run.

The interface of ServerStat is as follows:

    my $stat = MVC::Neaf::X::ServerStat->new (
        write_threshold_count => 100,
        write_threshold_time  => 1,
        on_write => sub {
            my $array_of_arrays = shift;

            foreach (@$array_of_arrays) {
                # @$_ = (script_name, http_status,
                #       controller_duration, total_duration, start_time)
                # do something with this data
                warn "$_->[0] returned $_->[1] in $_->[3] sec\n";
            };
        },
    );

on_write will be executed as soon as either count data points are accumulated,
or time is exceeded by difference between first and last request in batch.

Returns self.

=cut

sub server_stat {
    my ($self, $obj) = @_;
    $self = $Inst unless ref $self;

    if ($obj) {
        $self->{stat} = $obj;
    } else {
        delete $self->{stat};
    };

    return $self;
};

=head1 INTERNAL API

B<CAVEAT EMPTOR.>

The following methods are generally not to be used,
unless you want something very strange.

=cut


=head2 new(%options)

Constructor. Usually, instantiating Neaf is not required.
But it's possible.

Options are not checked whatsoever.

Just in case you're curious, $MVC::Neaf::Inst is the default instance
that handles MVC::Neaf->... requests.

=cut

sub new {
    my ($class, %opt) = @_;

    $opt{-type}     ||= "text/html";
    $opt{-view}     ||= "TT";
    $opt{defaults}  ||= { -status => 200 };
    $opt{on_error}  ||= sub {
        my ($req, $err, $where) = @_;
        my $msg = "ERROR: ".$req->script_name.": $err";
        if ($where) {
            $msg =~ s/\s+$//s;
            $msg .= " in $where->[1] line $where->[2]";
        };
        warn "$msg\n";
    };
    my $force = delete $opt{force_view};

    my $self = bless \%opt, $class;
    $self->set_forced_view( $force )
        if $force;

    return $self;
};

=head2 handle_request( MVC::Neaf::request->new )

This is the CORE of this module.
Should not be called directly - use run() instead.

=cut

sub handle_request {
    my ($self, $req) = @_;
    $self = $Inst unless ref $self;

    exists $self->{stat} and $self->{stat}->record_start;

    # ROUTE REQUEST
    my $route;
    my $data = eval {
        # Inject session handler into request object
        $req->_set_session_handler( $self->{session_handler} )
            if exists $self->{session_handler};

        # Try running the pre-routing callback.
        if (exists $self->{pre_route}) {
            $self->{pre_route}->( $req );
        };

        # Lookup the rules for the given path
        $req->path =~ $self->{route_re} and my $node = $self->{route}{$1}
            or die "404\n";
        unless ($route = $node->{ $req->method }) {
            $req->set_header( Allow => join ", ", keys %$node );
            die "405\n";
        };

        # TODO optimize this or do smth. Still MUST keep route_re a prefix tree
        my ($path, $path_info_regex) = ($1, $2);
        $path_info_regex =~ $route->{path_info_regex_regex}
            or die "404\n";
        $req->set_full_path( $path, $path_info_regex, !$route->{has_path_info_regex} );

        # Run the controller!
        return $route->{code}->($req);
    };

    if ($data) {
        # post-process data - fill in request(RD) & global(GD) defaults.
        # TODO fill in per-location defaults, too - but do we need them?
        my $RD = $req->get_default;
        my $GD = $self->{defaults};
        exists $data->{$_} or $data->{$_} = $RD->{$_} for keys %$RD;
        exists $data->{$_} or $data->{$_} = $GD->{$_} for keys %$GD;
    } else {
        # Fall back to error page
        $data = $self->_error_to_reply( $req, $@, $route->{caller} );
    };

    # END ROUTE REQUEST

    exists $self->{stat}
        and $self->{stat}->record_controller($req->script_name);

    # PROCESS REPLY

    # Render content if needed. This may alter type, so
    # produce headers later.
    my ($content, $type);
    if (defined $data->{-content}) {
        $content = $data->{-content};
    } else {
        my $view = $self->load_view( $data->{-view} || $route->{view} );
        if ( my $key = $self->{session_view_as} and my $sess = $req->session(1) ) {
            $data->{ $key } = $sess;
        };
        eval { ($content, $type) = $view->render( $data ); };
        if (!defined $content) {
            warn "ERROR: In view: $@";
            $data = {
                -status => 500,
                -type   => "text/plain",
            };
            $content = "Template error.";
        };
        $data->{-type} ||= $type || 'text/html';
    };

    # Encode unicode content NOW so that we don't lie about its length
    # Then detect ascii/binary
    if (Encode::is_utf8( $content )) {
        # UTF8 means text, period
        $content = encode_utf8( $content );
        $data->{-type} ||= 'text/plain';
        $data->{-type} .= "; charset=utf-8"
            unless $data->{-type} =~ /; charset=/;
    } elsif (!$data->{-type}) {
        # Autodetect binary. Plain text is believed to be in utf8 still
        $data->{-type} = $content =~ /^.{0,512}?[^\s\x20-\x7F]/s
            ? 'application/octet-stream'
            : 'text/plain; charset=utf-8';
    } elsif ($data->{-type} =~ m#^text/#) {
        # Some other text, mark as utf-8 just in case
        $data->{-type} .= "; charset=utf-8"
            unless $data->{-type} =~ /; charset=/;
    };

    # Mangle headers - these modifications remain stored in req
    my $head = $req->header_out;
    $head->init_header( content_type => $data->{-type} || $self->{-type} );
    $head->init_header( location => $data->{-location} )
        if $data->{-location};
    $head->push_header( set_cookie => $req->format_cookies );
    $head->init_header( content_length => length $content )
        unless $data->{-continue};
    $head->init_header( expires => _http_date( time + $route->{cache_ttl} ) )
        if exists $route->{cache_ttl} and $data->{-status} == 200;
    $content = '' if $req->method eq 'HEAD';

    # END PROCESS REPLY

    exists $self->{stat}
        and $self->{stat}->record_finish($data->{-status}, $req);

    # DISPATCH CONTENT

    if ($data->{-continue} and $req->method ne 'HEAD') {
        $req->postpone( $data->{'-continue'}, 1 );
        $req->postpone( sub { $_[0]->write( $content ); }, 1 );
        return $req->do_reply( $data->{-status} );
    } else {
        return $req->do_reply( $data->{-status}, $content );
    };

    # END DISPATCH CONTENT
}; # End handle_request()

sub _error_to_reply {
    my ($self, $req, $err, $where) = @_;

    if (blessed $err and $err->isa("MVC::Neaf::Exception")) {
        $err->{-status} ||= 500;
        return $err;
    };

    my $status = (!ref $err && $err =~ /^(\d\d\d)/) ? $1 : 500;

    # Try exception handler
    if( !$1 ) {
        exists $self->{on_error}
            and eval { $self->{on_error}->($req, $err, $where) };
        # ignore errors in error handler
        warn "ERROR: Error handler failed: $@"
            if $@;
    };

    # Try fancy error template
    if (exists $self->{error_template}{$status}) {
        my $ret = eval {
            $self->{error_template}{$status}->( $req,
                status => $status,
                caller => $where,
                error => $err,
            );
        };
        return $ret
            if (ref $ret eq 'HASH');
        warn "ERROR: Error status handler for $status failed: $@"
            if $@;
    };

    # Options exhausted - return plain error message
    return {
        -status     => $status,
        -type       => 'text/plain',
        -content    => "Error $status\n",
    };
};

# TODO Make this public?.. Move to Neaf::Util?
sub _http_date {
    my $t = shift;
    return strftime( "%a, %d %b %Y %H:%M:%S GMT", gmtime($t))
};

sub _croak {
    my ($self, $msg) = @_;

    my $where = [caller(1)]->[3];
    $where =~ s/.*:://;
    croak( (ref $self || $self)."->$where: $msg" );
};

=head2 run_test( \%PSGI_ENV )

Run a PSGI request and return ($status, HTTP::Headers, $whole_content ).

Just as the name suggests, useful for testing only (it reduces boilerplate).

Does NOT handle continuation requests.

=cut

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

    my $ret = $self->run->( $env );
    # TODO handle functional return, too!

    return (
        $ret->[0],
        HTTP::Headers->new( @{ $ret->[1] } ),
        join '', @{ $ret->[2] },
    );
};

=head1 MORE EXAMPLES

See the examples directory in this distro or at
L<https://github.com/dallaylaen/perl-mvc-neaf/tree/master/example>
for complete working examples.
These below are just code snippets.

All of them are supposed to start and end with:

    use strict;
    use warnings;
    use MVC::Neaf;

    # ... snippet here

    MVC::Neaf->run;

=head2 Static content

    MVC::Neaf->static( '/images' => "/local/images" );
    MVC::Neaf->static( '/favicon.ico' => "/local/images/icon_32x32.png" );

=head2 RESTful web-service returning JSON

    MVC::Neaf->route( '/restful' => sub {
        # ...
    }, method => 'GET', view => 'JS' );

    MVC::Neaf->route( '/restful' => sub {
        # ...
    }, method => 'POST', view => 'JS' );

    MVC::Neaf->route( '/restful' => sub {
        # ...
    }, method => 'PUT', view => 'JS' );

=head2 Form submission

    use MVC::Neaf::X::Form;

    my %profile = (
        name => [ required => '\w+' ],
        age  => '\d+',
    );
    my $validator = MVC::Neaf::X::Form->new( \%profile );

    MVC::Neaf->route( '/submit' => sub {
        my $req = shift;

        my $form = $req->form( $validator );
        if ($req->is_post and $form->is_valid) {
            do_somethong( $form->data );
            $req->redirect( "/result" );
        };

        return {
            -template   => 'form.tt',
            errors      => $form->error,
            fill_values => $form->raw,
        };
    } );

More examples to follow as usage (hopefuly) accumulates.

=head1 BUGS

Lots of them, this software is still under heavy development.

* Apache2 handler is a joke and requires work.
It can still serve requests though.

Please report any bugs or feature requests to
L<https://github.com/dallaylaen/perl-mvc-neaf/issues>.

Alternatively, email them to C<bug-mvc-neaf at rt.cpan.org>, or report through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MVC-Neaf>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

This is BETA software.
Feel free to email the author to get instant help!
Or you can comment the L<announce|http://perlmonks.org/?node_id=1174241>
at the Perlmonks forum.

You can find documentation for this module with the perldoc command.

    perldoc MVC::Neaf
    perldoc MVC::Neaf::Request

You can also look for information at:

=over 4

=item * Github: https://github.com/dallaylaen/perl-mvc-neaf

=item * MetaCPAN: https://metacpan.org/pod/MVC::Neaf

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MVC-Neaf>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/MVC-Neaf>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/MVC-Neaf>

=item * Search CPAN

L<http://search.cpan.org/dist/MVC-Neaf/>

=back

=head1 SEE ALSO

The L<Kelp> framework has very similar concept.

=head1 ACKNOWLEDGEMENTS

Ideas were shamelessly stolen from L<Catalyst>, L<Dancer>, and L<PSGI>.

Thanks to Eugene Ponizovsky aka L<IPH|https://metacpan.org/author/IPH>
for introducing me to the MVC concept.

=head1 LICENSE AND COPYRIGHT

Copyright 2016 Konstantin S. Uvarin.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1; # End of MVC::Neaf
