Revision: 28
Author: matt
Date: 2006-08-02 19:24:16 +0000 (Wed, 02 Aug 2006)
Log Message:
-----------
Allow transformers access to $client
Beginnings of parsing querystring code
Allow transformers to log
Make XSP not recompile every hit
Modified Paths:
--------------
trunk/lib/AxKit2/Connection.pm
trunk/lib/AxKit2/HTTPHeaders.pm
trunk/lib/AxKit2/Processor.pm
trunk/lib/AxKit2/Transformer/XSP.pm
trunk/lib/AxKit2/Transformer.pm
Added Paths:
-----------
trunk/lib/AxKit2/Utils.pm
Modified: trunk/lib/AxKit2/Connection.pm
===================================================================
--- trunk/lib/AxKit2/Connection.pm 2006-08-02 19:02:27 UTC (rev 27)
+++ trunk/lib/AxKit2/Connection.pm 2006-08-02 19:24:16 UTC (rev 28)
@@ -19,6 +19,7 @@
server_config
http_headers_sent
notes
+ sock_closed
);
use constant CLEANUP_TIME => 5; # every N seconds
@@ -40,6 +41,7 @@
$self->{alive_time} = $self->{create_time} = $now;
$self->{headers_string} = '';
+ $self->{closed} = 0;
$self->{ditch_leading_rn} = 0; # TODO - work out how to set that...
$self->{server_config} = $servconf;
$self->{notes} = {};
@@ -70,6 +72,7 @@
sub max_connect_time { 180 }
sub event_err { my AxKit2::Connection $self = shift; $self->close("Error") }
sub event_hup { my AxKit2::Connection $self = shift; $self->close("Disconnect
(HUP)") }
+sub close { my AxKit2::Connection $self = shift; $self->{sock_closed}++;
$self->SUPER::close(@_) }
sub event_read {
my AxKit2::Connection $self = shift;
@@ -166,7 +169,7 @@
$self->hook_fixup($hd)
&&
(
- $self->hook_xmlresponse(AxKit2::Processor->new($hd->filename))
+ $self->hook_xmlresponse(AxKit2::Processor->new($self, $hd->filename))
||
$self->hook_response($hd)
);
@@ -180,6 +183,8 @@
sub http_response_sent {
my AxKit2::Connection $self = $_[0];
+ return 0 if $self->{sock_closed};
+
# close if we're supposed to
if (
! defined $self->{headers_out} ||
Modified: trunk/lib/AxKit2/HTTPHeaders.pm
===================================================================
--- trunk/lib/AxKit2/HTTPHeaders.pm 2006-08-02 19:02:27 UTC (rev 27)
+++ trunk/lib/AxKit2/HTTPHeaders.pm 2006-08-02 19:24:16 UTC (rev 28)
@@ -6,6 +6,8 @@
use warnings;
no warnings qw(deprecated);
+use AxKit2::Utils qw(uri_decode);
+
use fields (
'headers', # href; lowercase header -> comma-sep list of values
'origcase', # href; lowercase header -> provided case
@@ -88,6 +90,7 @@
if ($self->{uri} =~ m!^http://([^/:]+?)(?::\d+)?(/.*)?$!) {
$absoluteURIHost = lc($1);
$self->{uri} = $2 || "/"; # "http://www.foo.com"; yields no path,
so default to "/"
+ $self->parse_uri;
}
# default to HTTP/0.9
@@ -165,6 +168,10 @@
return $self;
}
+sub parse_uri {
+ my AxKit2::HTTPHeaders $self = shift;
+}
+
sub http_code_english {
my AxKit2::HTTPHeaders $self = shift;
if (@_) {
Modified: trunk/lib/AxKit2/Processor.pm
===================================================================
--- trunk/lib/AxKit2/Processor.pm 2006-08-02 19:02:27 UTC (rev 27)
+++ trunk/lib/AxKit2/Processor.pm 2006-08-02 19:24:16 UTC (rev 28)
@@ -18,9 +18,10 @@
# ->new($path [, $input]);
sub new {
my $class = shift; $class = ref($class) if ref($class);
+ my $client = shift || die "A processor needs a client";
my $path = shift || die "A processor needs source document path";
- my $self = bless {path => $path}, $class;
+ my $self = bless {client => $client, path => $path}, $class;
@_ and $self->{input} = shift;
@_ and $self->{output} = shift;
@@ -38,6 +39,11 @@
$self->{input};
}
+sub client {
+ my $self = shift;
+ $self->{client};
+}
+
sub dom {
my $self = shift;
@_ and $self->{input} = shift;
@@ -92,10 +98,11 @@
my $pos = 0;
my ($dom, $outfunc);
for my $trans (@transforms) {
+ $trans->client($self->client);
($dom, $outfunc) = $trans->transform($pos, $self);
}
- return $self->new($self->path, $dom, $outfunc);
+ return $self->new($self->client, $self->path, $dom, $outfunc);
}
sub XSP {
Modified: trunk/lib/AxKit2/Transformer/XSP.pm
===================================================================
--- trunk/lib/AxKit2/Transformer/XSP.pm 2006-08-02 19:02:27 UTC (rev 27)
+++ trunk/lib/AxKit2/Transformer/XSP.pm 2006-08-02 19:24:16 UTC (rev 28)
@@ -5,6 +5,8 @@
use base qw(AxKit2::Transformer);
+use AxKit2::Constants;
+
sub new {
my $class = shift;
@@ -17,8 +19,7 @@
my $self = shift;
my ($pos, $processor) = @_;
- # TODO: figure out how to get this...
- my $cgi = undef;
+ $self->log(LOGINFO, "Transformer::XSP running");
# always need this
my $dom = XML::LibXML::Document->createDocument("1.0", "UTF-8");
@@ -26,13 +27,16 @@
my $key = $processor->path . $pos;
my $package = get_package_name($key);
- if ($processor->input || !defined &{"${package}::handler"}) {
+ if ($processor->input || !defined &{"${package}::xml_generator"}) {
# not already compiled or we have "input" so we need to recompile
+ $self->log(LOGDEBUG, "XSP (re)compiling $key");
+ $processor->input ? $self->log(LOGDEBUG, "... because we have input")
+ : $self->log(LOGDEBUG, "... because we can't see the
function");
$self->compile($key, $package, $processor);
}
my $cv = $package->can("handler") || die "Unable to get handler method";
- my $rc = eval { $package->$cv($cgi, $dom); };
+ my $rc = eval { $package->$cv($self->client, $dom); };
die $@ if $@;
return $dom;
Modified: trunk/lib/AxKit2/Transformer.pm
===================================================================
--- trunk/lib/AxKit2/Transformer.pm 2006-08-02 19:02:27 UTC (rev 27)
+++ trunk/lib/AxKit2/Transformer.pm 2006-08-02 19:24:16 UTC (rev 28)
@@ -10,4 +10,15 @@
# returns a dom
sub transform {}
+sub client {
+ my $self = shift;
+ @_ and $self->{client} = shift;
+ $self->{client};
+}
+
+sub log {
+ my $self = shift;
+ ($self->client || "AxKit2::Client")->log(@_);
+}
+
1;
\ No newline at end of file
Added: trunk/lib/AxKit2/Utils.pm
===================================================================
--- trunk/lib/AxKit2/Utils.pm 2006-08-02 19:02:27 UTC (rev 27)
+++ trunk/lib/AxKit2/Utils.pm 2006-08-02 19:24:16 UTC (rev 28)
@@ -0,0 +1,18 @@
+package AxKit2::Utils;
+
+use strict;
+use warnings;
+
+use Exporter ();
+
+our @EXPORT_OK = qw(uri_decode);
+
+sub uri_decode {
+ my $uri = shift;
+ return '' unless defined $uri;
+ $uri =~ s/\+/ /g;
+ $uri =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/eig;
+ return $uri;
+}
+
+1;
\ No newline at end of file
