view release on metacpan or  search on metacpan

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

sub ExpiresAbsolute { shift->{_expires_absolute} }


sub Status
{
  my $s = shift;
  
  @_ ? $s->context->r->status( $s->{_status} = +shift ) : $s->{_status};
}# end Status()


sub End
{
  my $s = shift;
  
  if( $s->Status =~ m{^2} )
  {
    $s->Flush;
  }
  else
  {
    delete $s->context->headers_out->{'content-type'};
  }# end if()
  
  # Would be nice to somehow stop all execution:
  $s->context->did_end( 1 );
}# end End()


sub Flush
{
  my $s = shift;
  $s->context->rflush;
}# end Flush()


sub Clear
{
  shift->context->rclear
}# end Clear()


sub IsClientConnected
{
  ! shift->context->r->connection->aborted();
}# end IsClientConnected()


sub Write
{
  my $s = shift;
  $s->context->rprint( shift(@_) )
}# end Write()


sub SetCookie
{
  my ($s, %args) = @_;
  
  $args{domain} ||= eval { $s->context->config->data_connections->session->cookie_domain } || $ENV{HTTP_HOST};
  $args{path}   ||= '/';
  my @parts = ( );
  push @parts, $s->context->server->URLEncode($args{name}) . '=' . $s->context->server->URLEncode($args{value});
  unless( $args{domain} eq '*' )
  {
    push @parts, 'domain=' . $s->context->server->URLEncode($args{domain});
  }# end unless()
  push @parts, 'path=' . $args{path};
  if( $args{expires} )
  {
    if( my ($num,$type) = $args{expires} =~ m/^(\-?\d+)([MHD])$/ )
    {
      my $expires;
      if( $type eq 'M' ) {
        # Minutes:
        $expires = time() + ( $num * 60 );
      }
      elsif( $type eq 'H' ) {
        # Hours:
        $expires = time() + ( $num * 60 * 60 );
      }
      elsif( $type eq 'D' ) {
        # Days:
        $expires = time() + ( $num * 60 * 60 * 24 );
      }# end if()
      push @parts, 'expires=' . time2str( $expires );
    }
    else
    {
      push @parts, 'expires=' . time2str( $args{expires} );
    }# end if()
  }# end if()
  $s->AddHeader( 'Set-Cookie' => join('; ', @parts) . ';' );
}# end SetCookie()


sub AddHeader
{
  my ($s, $name, $value) = @_;
  
  $s->context->headers_out->push_header( $name => $value );
}# end AddHeader()


sub SetHeader
{
  my ($s, $name, $value) = @_;
  
  $s->context->headers_out->header( $name => $value );
}# end AddHeader()


sub Headers
{
  my $s = shift;
  
  my $out = $s->context->headers_out;
  map {{
    $_ => $out->{$_}
  }} keys %$out;

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

C<%args> B<must> contain the following:

=over 4

=item * name

A string - the name of the cookie.

=item * value

The value of the cookie.

=back

Other parameters are:

=over 4

=item * expires

Can be in one of the following formats:

=over 8

=item * 30B<M>

Minutes - how many minutes from "now" calculated as C<time() + (30 * 60)>

Example:

  expires => '30M'
  expires => '-5M'  # 5 minutes ago

=item * 2B<H>

Hours - how many hours from "now" calculated as C<time() + (2 * 60 * 60)>

Example:

  expires => '2H'   # 2 hours
  expires => '12H'  # 12 Hours

=item * 7B<D>

Days - how many days from "now" calculated as C<time() + (7 * 60 * 60 * 24)>

Example:

  expires => '7D'   # A week
  expires => '30D'  # A month

=back

=item * path

Defaults to "C</>" - you can restrict the "path" that the cookie will apply to.

=item * domain

Defaults to whatever you set your config->data_connections->session->cookie_domain to
in your asp4-config.json.  Otherwise defaults to C<$ENV{HTTP_HOST}>.

You can override the defaults by passing in a domain, but the browser may not accept
other domains.  See L<http://www.ietf.org/rfc/rfc2109.txt> for details.

=back

=head2 Redirect( $url )

Causes the following HTTP header to be sent:

  Status: 301 Moved
  Location: $url

=head2 Include( $path [, \%args ] )

Executes the ASP script at C<$path> and includes its output.  Additional C<\%args>
may be passed along to the include.

The passed-in args are accessible to the include like this:

  <%
    my ($self, $context, $args) = @_;
    
    # Args is a hashref:
  %>

=head2 TrapInclude( $path [, \%args ] )

Executes the ASP script at C<$path> and returns its output.  Additional C<\%args>
may be passed along to the include.

The passed-in args are accessible to the include like this:

  <%
    my ($self, $context, $args) = @_;
    
    # Args is a hashref:
  %>

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ASP4> to submit bug reports.

=head1 HOMEPAGE

Please visit the ASP4 homepage at L<http://0x31337.org/code/> to see examples
of ASP4 in action.

=cut