Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

add Apache2 to examples

  • Loading branch information...
commit 3f7b7df6ee1dd331550441637d45165436f03d10 1 parent 2e90bd5
Ryo Anazawa authored
View
4 Changes
@@ -1,5 +1,9 @@
Revision history for Perl extension CGI::Header.
+ - Add examples/
+ - mv lib/CGI/Header/Apache2.pm examples/lib/CGI/Header/Apache2.pm
+ - CGI::Header::Apache2 isn't provided by this distribution.
+
0.59 (1.00-RC12) Jun 11th, 2013
- Remove CGI::Header#redirect and location
View
178 examples/lib/CGI/Header/Adapter.pm
@@ -1,178 +0,0 @@
-package CGI::Header::Adapter;
-use strict;
-use warnings;
-use parent 'CGI::Header';
-use Carp qw/croak/;
-
-sub crlf {
- $CGI::CRLF;
-}
-
-sub finalize {
- croak 'call to abstract method ', __PACKAGE__, '::finalize';
-}
-
-sub as_string {
- my $self = shift;
- my $query = $self->query;
- my $crlf = $self->crlf;
- my $headers = $self->as_arrayref;
-
- my @lines;
-
- # add Status-Line required by NPH scripts
- if ( $self->nph or $query->nph ) {
- my $protocol = $query->server_protocol;
- my $status = $self->process_newline( {@$headers}->{'Status'} || '200 OK' );
- push @lines, "$protocol $status$crlf";
- }
-
- # add response headers
- for ( my $i = 0; $i < @$headers; $i += 2 ) {
- my $field = $headers->[$i];
- my $value = $self->process_newline( $headers->[$i+1] );
- push @lines, "$field: $value$crlf";
- }
-
- push @lines, $crlf; # add an empty line
-
- join q{}, @lines;
-}
-
-sub process_newline {
- my $self = shift;
- my $value = shift;
- my $crlf = $self->crlf;
-
- # CR escaping for values, per RFC 822:
- # > Unfolding is accomplished by regarding CRLF immediately
- # > followed by a LWSP-char as equivalent to the LWSP-char.
- $value =~ s/$crlf(\s)/$1/g;
-
- # All other uses of newlines are invalid input.
- if ( $value =~ /$crlf|\015|\012/ ) {
- # shorten very long values in the diagnostic
- $value = substr($value, 0, 72) . '...' if length $value > 72;
- croak "Invalid header value contains a newline not followed by whitespace: $value";
- }
-
- $value;
-}
-
-sub as_arrayref {
- my $self = shift;
- my $query = $self->query;
- my %header = %{ $self->header };
-
- my ( $attachment, $charset, $cookies, $expires, $nph, $p3p, $status, $target, $type )
- = delete @header{qw/attachment charset cookies expires nph p3p status target type/};
-
- my @headers;
-
- $nph ||= $query->nph;
-
- push @headers, 'Server', $query->server_software if $nph;
- push @headers, 'Status', $status if $status;
- push @headers, 'Window-Target', $target if $target;
-
- if ( $p3p ) {
- my $tags = ref $p3p eq 'ARRAY' ? join ' ', @{$p3p} : $p3p;
- push @headers, 'P3P', qq{policyref="/w3c/p3p.xml", CP="$tags"};
- }
-
- my @cookies = ref $cookies eq 'ARRAY' ? @{$cookies} : $cookies;
- @cookies = map { $self->_bake_cookie($_) || () } @cookies;
-
- push @headers, map { ('Set-Cookie', $_) } @cookies;
- push @headers, 'Expires', $self->_date($expires) if $expires;
- push @headers, 'Date', $self->_date if $expires or @cookies or $nph;
- push @headers, 'Pragma', 'no-cache' if $query->cache;
-
- if ( $attachment ) {
- my $value = qq{attachment; filename="$attachment"};
- push @headers, 'Content-Disposition', $value;
- }
-
- push @headers, map { ucfirst $_, $header{$_} } keys %header;
-
- unless ( defined $type and $type eq q{} ) {
- my $value = $type || 'text/html';
- $charset = $query->charset if !defined $charset;
- $value .= "; charset=$charset" if $charset && $value !~ /\bcharset\b/;
- push @headers, 'Content-Type', $value;
- }
-
- \@headers;
-}
-
-sub _bake_cookie {
- my ( $self, $cookie ) = @_;
- ref $cookie eq 'CGI::Cookie' ? $cookie->as_string : $cookie;
-}
-
-sub _date {
- my ( $self, $expires ) = @_;
- CGI::Util::expires( $expires, 'http' );
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-CGI::Header::Adapter - Base class for adapters
-
-=head1 SYNOPSIS
-
- use parent 'CGI::Header::Adapter';
-
- sub finalize {
- ...
- }
-
-=head1 DESCRIPTION
-
-This module inherits from L<CGI::Header>, and also adds the following methods
-to the class:
-
-=over 4
-
-=item $headers = $header->as_arrayref
-
-Returns an arrayref which contains key-value pairs of HTTP headers.
-
- $header->as_arrayref;
- # => [
- # 'Content-length' => '3002',
- # 'Content-Type' => 'text/plain',
- # ]
-
-This method helps you write an adapter for L<mod_perl> or a L<PSGI>
-application which wraps your CGI.pm-based application without parsing
-the return value of CGI.pm's C<header> method.
-
-=item $header->as_string
-
-Returns the header fields as a formatted MIME header.
-If the C<nph> property is set to true, the Status-Line is inserted to
-the beginning of the response headers.
-
-=item $header->crlf
-
-Returns the system specific line ending sequence.
-
-=item $header->process_newline
-
-=back
-
-=head1 AUTHOR
-
-Ryo Anazawa (anazawa@cpan.org)
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
View
2  lib/CGI/Header/Apache2.pm → examples/lib/CGI/Header/Apache2.pm
@@ -72,7 +72,7 @@ CGI::Header::Apache2 - Adapter for Apache 2 mod_perl 2.x
return Apache2::Const::OK;
}
-=head1
+=head1 DESCRIPTION
Adapter for Apache2 mod_perl 2.x
Please sign in to comment.
Something went wrong with that request. Please try again.