view release on metacpan or  search on metacpan

lib/Kossy.pm  view on Meta::CPAN

our $SECURITY_HEADER = 1;
our $JSON_SERIALIZER;

# cache underscore translation
HTTP::Headers::Fast::_standardize_field_name('X-Frame-Options');

sub new {
    my $class = shift;
    my %args;
    if ( @_ < 2 ) {
        my $root_dir = shift;
        my @caller = caller;
        $root_dir ||= File::Basename::dirname( Cwd::realpath($caller[1]) );
        $args{root_dir} = $root_dir;
    }
    else {
        %args = @_;
    }

    bless \%args, $class;
}

sub psgi {
    my $self = shift;
    if ( ! ref $self ) {
        my %args;
        if ( @_ < 2 ) {
            my $root_dir = shift;
            my @caller = caller;
            $root_dir ||= File::Basename::dirname( Cwd::realpath($caller[1]) );
            $args{root_dir} = $root_dir;
        }
        else {
            %args = @_;
        }
        $self = $self->new(%args);
    }

    $self->build_app;
}

sub build_app {
    my $self = shift;

    my $security_header_local = $SECURITY_HEADER;
    my %match_cache;

    my $tx = __PACKAGE__->_build_text_xslate(
        root_dir  => $self->root_dir,
        cache     => $XSLATE_CACHE,
        cache_dir => $XSLATE_CACHE_DIR,
    );

    my $json_serializer = __PACKAGE__->_build_json_serializer();

    sub {
        my $env = shift;
        $Kossy::Response::SECURITY_HEADER = $security_header_local;
        try {
            my $header = bless {
                'content-type' => 'text/html; charset=UTF-8',
                $security_header_local ? ('x-frame-options' => 'DENY') : (),
            }, 'HTTP::Headers::Fast';
            my $c = Kossy::Connection->new({
                tx => $tx,
                req => Kossy::Request->new($env),
                res => Kossy::Response->new(200, $header),
                stash => {},
                json_serializer => $json_serializer,
            });
            my $method = uc($env->{REQUEST_METHOD});
            my $cache_key = $method . '-' . $env->{PATH_INFO};
            my ($match,$args) = try {
                if ( exists $match_cache{$cache_key} ) {
                    return @{$match_cache{$cache_key}};
                }
                my $path_info = Encode::decode_utf8( $env->{PATH_INFO},  Encode::FB_CROAK | Encode::LEAVE_SRC );
                my ($dest, $captured, $method_not_allowed) = $self->_router->match($method, $path_info);
                if ($method_not_allowed) {
                    $c->halt(405);
                }

                if (!$dest) {
                    $c->halt(404);
                }

                $match_cache{$cache_key} = [$dest, $captured];
                return ($dest, $captured);
            } catch {
                if ( ref $_ && ref $_ eq 'Kossy::Exception' ) {
                    die $_; #rethrow
                }
                $c->halt(400,'unexpected character in request');
            };

            my $code = $match->{__action__};
            my $filters = $match->{__filter__} || [];
            if ( $] == 5.020000 || $] == 5.020100 ) {
                # workaround for 5.20.0 or 5.20.1 https://github.com/kazeburo/Kossy/pull/10
                my %args = map { $_ => Encode::decode_utf8($args->{$_}) } keys %$args;
                $c->args(\%args);
            } else {
                $c->args({%$args});
            }
            my $app = sub {
                my ($self, $c) = @_;
                my $response;
                my $res = $code->($self, $c);
                Carp::croak "Undefined Response" if ! defined $res;
                my $res_t = ref($res) || '';
                if ( $res_t eq 'Kossy::Response' ) {
                    $response = $res;
                }
                elsif ( $res_t eq 'Plack::Response' ) {
                    $response = bless $res, 'Kossy::Response';
                }
                elsif ( $res_t eq 'ARRAY' ) {
                    $response = Kossy::Response->new(@$res);
                }
                elsif ( !$res_t ) {
                    $c->res->body($res);