view release on metacpan or  search on metacpan

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

=head1 NAME

Plasp::Response - $Response Object

=head1 SYNOPSIS

  use Plasp::Response;

  my $resp = Plasp::Response->new(asp => $asp);
  $resp->Write('<h1>Hello World!</h1>');
  my $body = $resp->Output;

=head1 DESCRIPTION

This object manages the output from the ASP Application and the client web
browser. It does not store state information like the $Session object but does
have a wide array of methods to call.

=cut

=head1 ATTRIBUTES

=over

=item $Response->{BinaryRef}

API extension. This is a perl reference to the buffered output of the
C<$Response> object, and can be used in the C<Script_OnFlush> F<global.asa>
event to modify the buffered output at runtime to apply global changes to
scripts output without having to modify all the scripts. These changes take
place before content is flushed to the client web browser.

  sub Script_OnFlush {
    my $ref = $Response->{BinaryRef};
    $$ref =~ s/\s+/ /sg; # to strip extra white space
  }

=cut

has 'BinaryRef' => (
    is      => 'rw',
    isa     => ScalarRef,
    default => sub { \( shift->Output ) }
);

# Store the buffered output as a Str attritube
has 'Output' => (
    is          => 'rw',
    isa         => Str,
    default     => '',
    clearer     => 'clear_Output',
    handles_via => 'String',
    handles     => {
        OutputLength => 'length',
        OutputSubstr => 'substr',
        Write        => 'append',
    },
);

# This attribute has no effect output will always be buffered, even in cases
# of streaming response.
has 'Buffer' => (
    is      => 'ro',
    default => 1,
);

=item $Response->{CacheControl}

Default C<"private">, when set to public allows proxy servers to cache the
content. This setting controls the value set in the HTTP header C<Cache-Control>

=cut

has 'CacheControl' => (
    is      => 'rw',
    isa     => Str,
    default => 'private',
);

before 'CacheControl' => sub {
    my $self = shift;
    $self->asp->log->warn(
        'Headers already written! Setting CacheControl has no effect!'
    ) if scalar( @_ ) && $self->_headers_written;
};

=item $Response->{Charset}

This member when set appends itself to the value of the Content-Type HTTP
header.  If C<< $Response->{Charset} = 'ISO-LATIN-1' >> is set, the
corresponding header would look like:

  Content-Type: text/html; charset=ISO-LATIN-1

=cut

has 'Charset' => (
    is      => 'rw',
    isa     => Str,
    default => '',
);

before 'Charset' => sub {
    my $self = shift;
    $self->asp->log->warn(
        'Headers already written! Setting Charset has no effect!'
    ) if scalar( @_ ) && $self->_headers_written;
};

# This attribute has no effect
has 'Clean' => (
    is      => 'ro',
    isa     => Int,
    default => 0,
);

=item $Response->{ContentType}

Default C<"text/html">. Sets the MIME type for the current response being sent
to the client. Sent as an HTTP header.

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

    my ( $self, $code, $uri ) = @_;
    $self->asp->log->warn(
        "\$Response->ErrorDocument has not been implemented!"
    );
    return;
}

=item $Response->Flush()

Sends buffered output to client and clears buffer.

=cut

# A _headers_writer is a reference to a subroutine that takes two arguments:
# ( $status, $headers_array_ref )
has '_headers_writer' => (
    is  => 'rw',
    isa => CodeRef,
);

# A _content_writer is a reference to a subroutine that takes one argument:
# ( $data )
has '_content_writer' => (
    is  => 'rw',
    isa => CodeRef,
);

sub Flush {
    my ( $self ) = @_;
    $self->asp->GlobalASA->Script_OnFlush;

    # If this is the first Flush, need to write out the headers and begin the
    # response.
    unless ( $self->_headers_written ) {

        # Process the resulting response
        $self->Status || $self->Status( 200 );

        # Process the response headers
        # Set Content-Type header
        my $charset      = $self->Charset;
        my $content_type = $self->ContentType;
        $content_type .= "; charset=$charset" if $charset;
        push @{ $self->Headers }, 'Content-Type' => $content_type;

        # Set the Cookies
        push @{ $self->Headers }, @{ $self->CookiesHeaders };

        # Set the Cache-Control
        push @{ $self->Headers }, 'Cache-Control' => $self->CacheControl;

        # Set the Expires header from either Expires or ExpiresAbsolute
        # attribute
        if ( $self->Expires ) {
            push @{ $self->Headers },
                Expires => time2str( time + $self->Expires );
        } elsif ( $self->ExpiresAbsolute ) {
            push @{ $self->Headers }, Expires => $self->ExpiresAbsolute;
        }

        # In the case that streaming response is supported, a _headers_writer
        # should be defined. If so, use it to write out the Status and Headers
        if ( $self->_headers_writer ) {
            $self->_headers_writer->( $self->Status, $self->Headers );
        }

        # Headers are written, so don't write them out again, even if not
        # streaming response
        $self->_set_headers_written;
    }

    my $body = $self->Output;

    # Process HTML::FillInForm
    if ( $self->FormFill ) {
        my @errors;
        $body =~ s/(\<form[^\>]*\>.*?\<\/form\>)/
            {
                my $form = $1;

                # HTML::FillInForm::ForceUTF8->_get_param expects all form data
                # to be a string or an arrayref. File uploads are actually
                # objects (CGI::File::Temp), so there's a 500 error if the form
                # field tries to populate with that data. This loop removes any
                # form data that is a reference to something that isn't an
                # array.
                my $form_data = $self->asp->Request->Form;
                for ( keys %$form_data ) {
                    my $form_ref = ref $form_data->{$_};
                    delete $form_data->{$_}
                        if $form_ref && $form_ref ne 'ARRAY';
                }

                eval {
                    my $fif = HTML::FillInForm::ForceUTF8->new;
                    $form = $fif->fill(
                        scalarref => \$form,
                        fdat      => $form_data,
                    );
                };
                if ( $@ ) {
                    push @errors, $@;
                }

                $form;
            }
            /iexsg;
        if ( @errors ) {
            my $errors = join ' : ', @errors;
            Plasp::Exception::Code->throw( "HTML::FillInForm failed: $errors" );
        }
    }

    if ( my $charset = $self->Charset ) {
        $body = Encode::encode( $charset, $body );
    } elsif ( $self->ContentType =~ /text|javascript|json/ ) {
        $body = Encode::encode( 'UTF-8', $body );
    }

    if ( $self->_content_writer ) {

        # In the case that streaming response is supported, a _content_writer
        # should be defined. If so, use it to write out the body, then clear
        # Output buffer.
        $self->_content_writer->( $body );
        $self->Clear;

    } else {

        # If streaming response not supported, then keep track of a flushed
        # offset and save the output up to that point.
        $self->_flushed_offset( $self->OutputLength );
    }


}

=item $Response->Include($filename, @args)

This API extension calls the routine compiled from asp script in C<$filename>
with the args @args.  This is a direct translation of the SSI tag

  <!--#include file=$filename args=@args-->

Please see the SSI section for more on SSI in general.

This API extension was created to allow greater modularization of code by
allowing includes to be called with runtime arguments.  Files included are
compiled once, and the anonymous code ref from that compilation is cached, thus
including a file in this manner is just like calling a perl subroutine. The
C<@args> can be found in C<@_> in the includes like:

  # include.inc
  <% my @args = @_; %>

As of C<2.23>, multiple return values can be returned from an include like:

  my @rv = $Response->Include($filename, @args);

=item $Response->Include(\$script_text, @args)

Added in Apache::ASP C<2.11>, this method allows for executing ASP scripts that
are generated dynamically by passing in a reference to the script data instead
of the file name. This works just like the normal C<< $Response->Include() >>
API, except a string reference is passed in instead of a filename. For example:

  <%
    my $script = "<\% print 'TEST'; %\>";
    $Response->Include(\$script);
  %>

This include would output C<TEST>. Note that tokens like C<< <% >> and C<< %> >>
must be escaped so Apache::ASP does not try to compile those code blocks
directly when compiling the original script. If the C<$script> data were fetched
directly from some external resource like a database, then these tokens would
not need to be escaped at all as in:

  <%
    my $script = $dbh->selectrow_array(
       "select script_text from scripts where script_id = ?",
       undef, $script_id
       );
    $Response->Include(\$script);
  %>

This method could also be used to render other types of dynamic scripts, like
XML docs using XMLSubs for example, though for complex runtime XML rendering,
one should use something better suited like XSLT.

=cut