Apache-HeavyCGI
view release on metacpan or search on metacpan
lib/Apache/HeavyCGI.pm view on Meta::CPAN
$self->{CAN_UTF8} = 0;
}
return $self->{CAN_UTF8};
}
my $protocol = $self->{R}->protocol || "";
my($major,$minor) = $protocol =~ m|HTTP/(\d+)\.(\d+)|;
$self->{CAN_UTF8} = $major >= 1 && $minor >= 1;
}
sub deliver {
my Apache::HeavyCGI $self = shift;
my $r = $self->{R};
# warn "Going to send_http_header";
$r->send_http_header;
return OK if $r->method eq "HEAD";
# warn "Going to print content";
$r->print($self->{CONTENT});
DONE; # we've sent the headers and the body, apache shouldn't talk
# to the browser anymore
}
sub handler {
warn "The handler of the request hasn't defined a handler subroutine.";
__PACKAGE__->new( R => shift )->dispatch;
}
sub dispatch {
my Apache::HeavyCGI $self = shift;
$self->init;
eval { $self->prepare; };
if ($@) {
if (UNIVERSAL::isa($@,"Apache::HeavyCGI::Exception")) {
if ($@->{ERROR}) {
warn "\$\@ ERROR[$@->{ERROR}]";
$@->{ERROR} = [ $@->{ERROR} ] unless ref $@->{ERROR};
warn "\$\@ ERROR[$@->{ERROR}]";
push @{$self->{ERROR}}, @{$@->{ERROR}};
warn "self ERROR[$self->{ERROR}]";
} elsif ($@->{HTTP_STATUS}) {
return $@->{HTTP_STATUS};
}
} else {
# this is not a known error type, we need to handle it anon
if ($self->{ERRORS_TO_BROWSER}) {
push @{$self->{ERROR}}, " ", $@;
} else {
$self->{R}->log_error($@);
return SERVER_ERROR;
}
}
}
return $self->{DONE} if $self->{DONE}; # backwards comp now, will go away
$self->{CONTENT} = $self->layout->as_string($self);
$self->finish;
$self->deliver;
}
sub expires {
my Apache::HeavyCGI $self = shift;
my($set) = @_;
$set = Apache::HeavyCGI::Date->new(unix => $set)
if defined($set) and not ref($set); # allow setting to a number
$self->{EXPIRES} = $set if defined $set;
return $self->{EXPIRES}; # even if not defined $self->{EXPIRES};
}
sub finish {
my Apache::HeavyCGI $self = shift;
my $r = $self->{R};
my $content_type = "text/html";
$content_type .= "; charset=$self->{CHARSET}" if defined $self->{CHARSET};
$r->content_type($content_type);
eval { require Compress::Zlib; };
$self->{CAN_GZIP} = 0 if $@; # we cannot compress anyway :-)
if ($self->can_gzip) {
$r->header_out('Content-Encoding', 'gzip');
$self->{CONTENT} = Compress::Zlib::memGzip($self->{CONTENT});
}
$r->header_out('Vary', join ", ", 'accept-encoding');
$r->header_out('Expires', $self->expires->http) if $self->expires;
$r->header_out('Last-Modified',$self->last_modified->http);
$r->header_out('Content-Length', length($self->{CONTENT}));
}
sub init {
return;
}
sub instance_of {
my($self,$class) = @_;
return $class->instance if $class->can("instance");
my $requirefile = $class;
$requirefile =~ s/::/\//g;
$requirefile .= ".pm";
# warn "requiring[$requirefile]";
require $requirefile;
$class->instance;
}
sub layout {
my Apache::HeavyCGI $self = shift;
require Apache::HeavyCGI::Layout;
my @l;
push @l, qq{<html><head><title>Apache::HeavyCGI default page</title>
</head><body><pre>};
push @l, $self->instance_of("Apache::HeavyCGI::Debug");
push @l, qq{</pre></body></html>};
Apache::HeavyCGI::Layout->new(@l);
}
sub last_modified {
my Apache::HeavyCGI $self = shift;
my($set) = @_;
$set = Apache::HeavyCGI::Date->new(unix => $set)
if defined($set) and not ref($set); # allow setting to a number
$self->{LAST_MODIFIED} = $set if defined $set;
return $self->{LAST_MODIFIED} if defined $self->{LAST_MODIFIED};
$self->{LAST_MODIFIED} =
Apache::HeavyCGI::Date->new(unix => $self->time);
}
sub myurl {
my Apache::HeavyCGI $self = shift;
return $self->{MYURL} if defined $self->{MYURL};
require URI::URL;
my $r = $self->{R} or
return URI::URL->new("http://localhost");
my $script_name = substr(
$r->uri,
0,
length($r->uri)-length($r->path_info)
);
my $port = $r->server->port || 80;
my $protocol = $port == 443 ? "https" : "http";
my $explicit_port = ($port == 80 || $port == 443) ? "" : ":$port";
$self->{MYURL} = URI::URL->new(
"$protocol://" .
$r->server->server_hostname .
$explicit_port .
$script_name);
}
sub new {
my($class,%opt) = @_;
no strict "refs";
my $self = bless {}, $class;
while (my($k,$v) = each %opt) {
$self->{$k} = $v;
}
$self;
}
sub prepare {
my Apache::HeavyCGI $self = shift;
if (my $ep = $self->{EXECUTION_PLAN}) {
$ep->walk($self);
} else {
die "No execution plan!";
}
}
sub serverroot_url {
my Apache::HeavyCGI $self = shift;
return $self->{SERVERROOT_URL} if $self->{SERVERROOT_URL};
require URI::URL;
my $r = $self->{R} or
return URI::URL->new("http://localhost");
my $host = $r->server->server_hostname;
my $port = $r->server->port || 80;
my $protocol = $port == 443 ? "https" : "http";
my $explicit_port = ($port == 80 || $port == 443) ? "" : ":$port";
$self->{SERVERROOT_URL} = URI::URL->new(
"$protocol\://" .
$host .
$explicit_port .
"/"
);
}
( run in 2.143 seconds using v1.01-cache-2.11-cpan-fe3c2283af0 )