view release on metacpan or  search on metacpan

lib/Plasp/App.pm  view on Meta::CPAN

            }

            # Parse and compile the ASP code
            $compiled = $_asp->compile_file(
                path( $_asp->DocumentRoot, $req->path_info )->stringify
            );

            1;
        } catch {

            if ( $_asp && blessed( $_ ) ) {

                # Handle not found exception
                if ( $_->isa( 'Plasp::Exception::NotFound' ) ) {
                    $error_response = _not_found_response();
                } else {

                    # Handle code or compilation exception by loggin it
                    $_asp->error( sprintf( "Encountered %s error: %s",
                            $_->isa( 'Plasp::Exception::Code' )
                            ? 'application code'
                            : 'unknown compilation',
                            $_
                    ) ) unless $_asp->has_errors;

                    $error_response = _error_response( undef, '500_error' );
                }

            } else {

                # Plasp error due to error in Plasp code. $asp and $Response is
                # not reliable. This implies a bug in Plasp.
                Plasp->log->fatal( "Plasp error: $_" );

                $error_response = _error_response(
                    undef,
                    'plasp_error',
                    $class->config->{Debug} ? "<pre>$_</pre>" : ''
                );
            }

            # Ensure return value is false to signify failure
            return;
        };

        unless ( $success ) {
            $_asp->cleanup;

            return $error_response;
        }

        # Define a callback once server is ready to write data to client. The
        # callback is called and passed subroutine called a responder.
        my $callback = sub {

            # Setup a hash here holding references to various objects at this
            # scope, so that the closures for calling the responder will be
            # able to write to this scope.
            my %refs = ( responder => shift );

            # If a responder is passed in, that means streaming response is
            # supported so pass a closure to write out headers and body
            if ( $refs{responder} ) {
                $_asp->Response->_headers_writer(
                    sub { $refs{writer} = $refs{responder}->( \@_ ) }
                );
                $_asp->Response->_content_writer(
                    sub { $refs{writer}->write( @_ ) }
                );
            }

            # Keep the stacktrace available for exception processing
            $success = try {
                local $SIG{__DIE__} = sub {
                    $_asp->_stack_trace( Devel::StackTrace->new(
                        frame_filter => $stack_trace_ignore,
                    ) );
                };
                local $SIG{__WARN__} = sub {
                    $_asp->log->warn(
                        $_[0],
                        stack_trace => Devel::StackTrace->new(
                            frame_filter => $stack_trace_ignore,
                        )->as_string
                    );
                };

                # Execute the code, render the ASP page
                $_asp->GlobalASA->Script_OnStart;
                $_asp->execute( $compiled->{code} );

                1;
            } catch {
                if ( blessed( $_ ) ) {

                    # A Redirect or End might come here (without already being
                    # caught). In that case, just ignore it and continue
                    # processing.

                    if ( $_->isa( 'Plasp::Exception::Code' ) ) {

                        # If an application error occured, log the error along
                        # with the stack trace that was captured
                        $_asp->error(
                            "Encountered application error: $_",
                            stack_trace => $_->stack_trace,
                        );
                    }

                    # Plasp application reported errors
                    $error_response = _error_response(
                        $refs{responder},
                        '500_error'
                    ) if $_asp->has_errors;
                } else {

                    # Plasp did not throw exception, implying a bug in Plasp
                    # itself
                    $_asp->log->fatal( "Plasp error: $_" );
                    $error_response = _error_response(
                        $refs{responder},
                        'plasp_error',
                        $_asp->config->{Debug} ? "<pre>$_</pre>" : ''
                    );
                }

                return;
            } finally {
                if ( $_asp ) {

                    # Do one final $Response->Flush
                    my $resp = $_asp->Response;
                    $resp->Flush;

                    if ( $refs{writer} ) {

                        # Close the writer so as to conclude the response to the
                        # client
                        $refs{writer}->close;

                    } else {

                        # If not using streaming response, then save response
                        # for reference later
                        $refs{status}  = $resp->Status;
                        $refs{headers} = $resp->Headers;
                        $refs{body}    = [ $resp->Output ];
                    }

                    # Ensure destruction!
                    $_asp->cleanup;
                }
            };

            # If a responder was passed in, then no need to return anything,
            # but otherwise need to return the PSGI three-element array
            unless ( $refs{responder} ) {
                return $success
                    ? \( @refs{qw(status headers body)} )
                    : $error_response;
            }
        };

        if ( $_asp->req->env->{'psgi.streaming'} ) {

            # Return the callback subroutine if streaming is supported
            return $callback;
        } else {

            # Manually call the callback to get response
            return $callback->();
        }

    }
}

# Construct error response
sub _error_response {
    my $responder  = shift;
    my $error_type = shift;

    my $body = sprintf( $_error_docs{$error_type}, @_ );
    if ( $_asp ) {
        $_asp->Response->Status( 500 );
        $_asp->Response->ContentType( 'text/html' );

        if ( $_asp->Error500Path ) {
            my $compiled = $_asp->compile_file(
                path( $_asp->DocumentRoot, $_asp->Error500Path )->stringify
            );
            $_asp->execute( $compiled->{code} );

            $body = $_asp->Response->Output;
        } else {

            $_asp->Response->Output( $body );
        }
    }

    # If a responder is defined, then the responder would already have written
    # out the error Response, but otherwise return the three-element array
    unless ( $responder ) {
        return [ 500, [ 'Content-Type' => 'text/html' ], [$body] ];
    }
}

# Construct not found response
sub _not_found_response {
    my $body;
    if ( $_asp && $_asp->Error404Path ) {

        my $compiled = $_asp->compile_file(
            path( $_asp->DocumentRoot, $_asp->Error404Path )->stringify
        );
        $_asp->execute( $compiled->{code} );

        $body = $_asp->Response->Output;
    } else {
        $body = $_error_docs{'404_not_found'};
    }

    return [ 404, [ 'Content-Type' => 'text/html' ], [$body] ];
}


1;