Revision: 125
Author: jwalt
Date: 2006-08-24 19:56:08 +0000 (Thu, 24 Aug 2006)
Log Message:
-----------
Update MANIFEST, fix a few typos and convert all those tabs to spaces.
Modified Paths:
--------------
trunk/MANIFEST
trunk/lib/AxKit2/Client.pm
trunk/lib/AxKit2/Plugin.pm
trunk/lib/AxKit2/Test.pm
trunk/lib/AxKit2/Utils.pm
trunk/plugins/typeless_uri
trunk/plugins/uri_to_file
Modified: trunk/MANIFEST
===================================================================
--- trunk/MANIFEST 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/MANIFEST 2006-08-24 19:56:08 UTC (rev 125)
@@ -64,6 +64,8 @@
lib/AxKit2/Plugin.pm
lib/AxKit2/Processor.pm
lib/AxKit2/Server.pm
+lib/AxKit2/Test.pm
+lib/AxKit2/Test.pm.orig
lib/AxKit2/Transformer.pm
lib/AxKit2/Transformer/TAL.pm
lib/AxKit2/Transformer/XPathScript.pm
@@ -78,6 +80,8 @@
MANIFEST.SKIP
META.yml Module meta-data (added by MakeMaker)
NOTICE
+plugins/aio/serve_file
+plugins/aio/uri_to_file
plugins/cachecache
plugins/demo/doc_viewer
plugins/demo/gallery
@@ -89,12 +93,20 @@
plugins/dir_to_xml
plugins/error_xml
plugins/fast_mime_map
+plugins/logging/file
plugins/logging/warn
plugins/magic_mime_map
plugins/request_log
plugins/serve_cgi
plugins/serve_file
plugins/stats
+plugins/typeless_uri
plugins/uri_to_file
README
+t/10uri_to_file.t
+t/11typeless_uri.t
+t/server1/foo/index.html
+t/server1/index.html
+t/server1/multi.html
+t/server1/multi/index.html
TODO.txt
Modified: trunk/lib/AxKit2/Client.pm
===================================================================
--- trunk/lib/AxKit2/Client.pm 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/lib/AxKit2/Client.pm 2006-08-24 19:56:08 UTC (rev 125)
@@ -419,7 +419,7 @@
# stolen shamelessly from httpd-2.2.2/modules/http/http_protocol.c
sub default_error_out {
my ($self, $code, $extras) = @_;
- $extras = '' unless defined $extras;
+ $extras = '' unless defined $extras;
$self->headers_out->code($code);
Modified: trunk/lib/AxKit2/Plugin.pm
===================================================================
--- trunk/lib/AxKit2/Plugin.pm 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/lib/AxKit2/Plugin.pm 2006-08-24 19:56:08 UTC (rev 125)
@@ -129,20 +129,20 @@
my $line = "\n#line 0 $file\n";
my $eval = join(
- "\n",
- "package $package;",
- 'use AxKit2::Constants;',
- 'use AxKit2::Processor;',
- "require AxKit2::Plugin;",
- 'use vars qw(@ISA);',
+ "\n",
+ "package $package;",
+ 'use AxKit2::Constants;',
+ 'use AxKit2::Processor;',
+ "require AxKit2::Plugin;",
+ 'use vars qw(@ISA);',
'use strict;',
- '@ISA = qw(AxKit2::Plugin);',
- "sub plugin_name { qq[$plugin] }",
- "sub hook_name { return shift->{_hook}; }",
- $line,
- $sub,
- "\n", # last line comment without newline?
- );
+ '@ISA = qw(AxKit2::Plugin);',
+ "sub plugin_name { qq[$plugin] }",
+ "sub hook_name { return shift->{_hook}; }",
+ $line,
+ $sub,
+ "\n", # last line comment without newline?
+ );
#warn "eval: $eval";
Modified: trunk/lib/AxKit2/Test.pm
===================================================================
--- trunk/lib/AxKit2/Test.pm 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/lib/AxKit2/Test.pm 2006-08-24 19:56:08 UTC (rev 125)
@@ -49,7 +49,7 @@
my $server;
-=head2 start_server <config> | <docroot> <plugins> directives
+=head2 start_server <config> | <docroot> <plugins> <directives>
This takes either a configuration file excerpt as a string (anything that goes
inside a <Server></Server> block),
or the document root, a list of plugins to load and a list of other
configuration directives.
@@ -61,81 +61,81 @@
my $port = get_free_port();
- if (defined $plugins) {
- $directives ||= [];
- $docroot = File::Spec->rel2abs($docroot);
- $server = AxKit2::Test::Server->new($port,"DocumentRoot
$docroot\n" .
- join("\n",map { "Plugin $_" } @$plugins) . "\n" .
- join("\n",@$directives) . "\n");
- } else {
- $server = AxKit2::Test::Server->new($port, $docroot);
- }
+ if (defined $plugins) {
+ $directives ||= [];
+ $docroot = File::Spec->rel2abs($docroot);
+ $server = AxKit2::Test::Server->new($port,"DocumentRoot $docroot\n" .
+ join("\n",map { "Plugin $_" } @$plugins) . "\n" .
+ join("\n",@$directives) . "\n");
+ } else {
+ $server = AxKit2::Test::Server->new($port, $docroot);
+ }
- return $server;
+ return $server;
}
sub stop_server {
- $server->shutdown();
- undef $server;
+ $server->shutdown();
+ undef $server;
}
sub http_get {
- my ($url) = @_;
- $url = "http://localhost:$server_port$url"; if $url !~
m/^[a-z0-9]{1,6}:/i;
- my $req = new HTTP::Request(GET => $url);
- return ($req, $ua->request($req));
+ my ($url) = @_;
+ $url = "http://localhost:$server_port$url"; if $url !~ m/^[a-z0-9]{1,6}:/i;
+ my $req = new HTTP::Request(GET => $url);
+ return ($req, $ua->request($req));
}
sub content_is {
- my ($url, $content, $name) = @_;
- my $builder = __PACKAGE__->builder;
- my $res = http_get($url);
- if (!$res->is_success) {
- $builder->ok(0,$name);
- $builder->diag("Request for '${url}' failed with error code
".$res->status_line);
- return 0;
- }
- my $got = $res->content;
- $got =~ s/[\r\n]*$//;
- $content =~ s/[\r\n]*$//;
- $builder->ok($res->content eq $content, $name) or
$builder->diag("Request for '${url}' failed:
+ my ($url, $content, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ my $res = http_get($url);
+ if (!$res->is_success) {
+ $builder->ok(0,$name);
+ $builder->diag("Request for '${url}' failed with error code
".$res->status_line);
+ return 0;
+ }
+ my $got = $res->content;
+ $got =~ s/[\r\n]*$//;
+ $content =~ s/[\r\n]*$//;
+ $builder->ok($res->content eq $content, $name) or $builder->diag("Request
for '${url}' failed:
got: $got
expected: $content");
}
sub is_redirect {
- my ($url, $dest, $name) = @_;
- my $builder = __PACKAGE__->builder;
- $ua->max_redirect(0);
- $dest = "http://localhost:$server_port$dest";;
- my $res = http_get($url);
- $ua->max_redirect(7);
- my $got = $res->code;
- my $gotdest = $res->header('Location');
- $builder->ok($res->is_redirect && $dest eq $gotdest, $name) or
$builder->diag("Request for '${url}' failed:" .
- ($res->is_redirect? "" : "\n got status: $got, expected a
redirect") .
- ($dest eq $gotdest? "" : "\n got destination:
$gotdest\nexpected destination: $dest"));
+ my ($url, $dest, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ $ua->max_redirect(0);
+ $dest = "http://localhost:$server_port$dest";;
+ my $res = http_get($url);
+ $ua->max_redirect(7);
+ my $got = $res->code;
+ my $gotdest = $res->header('Location');
+ $builder->ok($res->is_redirect && $dest eq $gotdest, $name) or
$builder->diag("Request for '${url}' failed:" .
+ ($res->is_redirect? "" : "\n got status: $got, expected a
redirect") .
+ ($dest eq $gotdest? "" : "\n got destination: $gotdest\nexpected
destination: $dest"));
}
sub no_redirect {
- my ($url, $dest, $name) = @_;
- my $builder = __PACKAGE__->builder;
- $ua->max_redirect(0);
- $dest = "http://localhost:$server_port$dest";;
- my $res = http_get($url);
- $ua->max_redirect(7);
- my $got = $res->code;
- my $gotdest = $res->header('Location');
- $builder->ok(!$res->is_redirect) or $builder->diag("Request for
'${url}' failed:
+ my ($url, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ $ua->max_redirect(0);
+ $dest = "http://localhost:$server_port$dest";;
+ my $res = http_get($url);
+ $ua->max_redirect(7);
+ my $got = $res->code;
+ my $gotdest = $res->header('Location');
+ $builder->ok(!$res->is_redirect, $name) or $builder->diag("Request for
'${url}' failed:
got status: $got -> $gotdest, expected non-redirect status");
}
sub status_is {
- my ($url, $status, $name) = @_;
- my $builder = __PACKAGE__->builder;
- my $res = http_get($url);
- my $got = $res->code;
- $builder->ok($got == $status, $name) or $builder->diag("Request for
'${url}' failed:
+ my ($url, $status, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ my $res = http_get($url);
+ my $got = $res->code;
+ $builder->ok($got == $status, $name) or $builder->diag("Request for
'${url}' failed:
got status: $got
expected status: $status");
}
Modified: trunk/lib/AxKit2/Utils.pm
===================================================================
--- trunk/lib/AxKit2/Utils.pm 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/lib/AxKit2/Utils.pm 2006-08-24 19:56:08 UTC (rev 125)
@@ -33,9 +33,9 @@
}
sub uri_decode {
- my $uri = shift;
- return '' unless defined $uri;
- $uri =~ s/\+/ /g;
+ my $uri = shift;
+ return '' unless defined $uri;
+ $uri =~ s/\+/ /g;
$uri =~ s/
% # encoded data marker
(?: # followed by either
@@ -46,7 +46,7 @@
/
defined($1) ? chr hex($1) : utf8_chr(hex($2))
/gex;
- return $uri;
+ return $uri;
}
# borrowed from CGI::Util which I think borrowed it from XML::DOM...
Modified: trunk/plugins/typeless_uri
===================================================================
--- trunk/plugins/typeless_uri 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/plugins/typeless_uri 2006-08-24 19:56:08 UTC (rev 125)
@@ -35,7 +35,7 @@
This plugin provides the filename for a given URI. It supplements uri_to_file
and
provides typeless URIs, i.e. URIs that do not contain a file extension.
-See L<http://www.w3.org/Provider/Style/URI> for a discussion, why this is a
Good Thing (TM).
+See L<http://www.w3.org/Provider/Style/URI> for a discussion of why this is a
Good Thing (TM).
It works by trying several extensions on the given URI until the resulting
file exists.
@@ -53,11 +53,11 @@
use File::Spec::Functions qw(canonpath catfile);
use constant EXTENSIONS => [
- 'xhtml',
- 'html',
- 'xsp',
- 'pl',
- 'cgi',
+ 'xhtml',
+ 'html',
+ 'xsp',
+ 'pl',
+ 'cgi',
];
sub init {
@@ -76,27 +76,27 @@
sub hook_uri_translation {
my ($self, $hd, $uri) = @_;
- my $file = $hd->filename;
- return DECLINED if -f $file;
+ my $file = $hd->filename;
+ return DECLINED if -f $file;
do {
- $file =
canonpath(catfile($file,$self->config->notes('uri_to_file::dirindex')))
- if -d _ && !$self->client->notes('need_redirect');
- $self->log(LOGINFO, "typeless: $uri -> $file.*");
+ $file =
canonpath(catfile($file,$self->config->notes('uri_to_file::dirindex')))
+ if -d _ && !$self->client->notes('need_redirect');
+ $self->log(LOGINFO, "typeless: $uri -> $file.*");
- my $extensions = $self->config('extensions') || EXTENSIONS;
- for my $extension (@$extensions) {
- if (-f $file.'.'.$extension) {
- $hd->filename($file.'.'.$extension);
- $self->log(LOGDEBUG, "Translated $uri to ".
$hd->filename);
- $self->client->notes('need_redirect', 0);
- return DECLINED;
- }
- }
+ my $extensions = $self->config('extensions') || EXTENSIONS;
+ for my $extension (@$extensions) {
+ if (-f $file.'.'.$extension) {
+ $hd->filename($file.'.'.$extension);
+ $self->log(LOGDEBUG, "Translated $uri to ". $hd->filename);
+ $self->client->notes('need_redirect', 0);
+ return DECLINED;
+ }
+ }
- return DECLINED if ! -d $file ||
$self->client->notes('need_redirect');
- $file =
canonpath(catfile($file,$self->config->notes('uri_to_file::dirindex')));
- } while (1);
+ return DECLINED if ! -d $file || $self->client->notes('need_redirect');
+ $file =
canonpath(catfile($file,$self->config->notes('uri_to_file::dirindex')));
+ } while (1);
return DECLINED;
}
Modified: trunk/plugins/uri_to_file
===================================================================
--- trunk/plugins/uri_to_file 2006-08-24 19:22:32 UTC (rev 124)
+++ trunk/plugins/uri_to_file 2006-08-24 19:56:08 UTC (rev 125)
@@ -75,29 +75,29 @@
$uri =~ s/^\Q$root// || die "$uri did not match config path $root";
- my ($volume, $dir, $file) = splitpath($self->config->docroot, 1);
- my @path = (splitdir($dir),split(/\//,$uri));
+ my ($volume, $dir, $file) = splitpath($self->config->docroot, 1);
+ my @path = (splitdir($dir),split(/\//,$uri));
- my $i = -1;
+ my $i = -1;
if (-d catpath($volume,catdir(@path),'')) {
- $i = @path-1;
- if ($original_uri =~ m/\/$/) {
- push @path, $self->config('dirindex')
- if (defined $self->config('dirindex') && -f
catpath($volume,catdir(@path),$self->config('dirindex')));
- } else {
- $self->client->notes('need_redirect',1);
- }
+ $i = @path-1;
+ if ($original_uri =~ m/\/$/) {
+ push @path, $self->config('dirindex')
+ if (defined $self->config('dirindex') && -f
catpath($volume,catdir(@path),$self->config('dirindex')));
+ } else {
+ $self->client->notes('need_redirect',1);
+ }
} else {
- my $path = '';
- foreach my $dir (@path) {
- $path = catdir($path,$dir);
- last unless -d catpath($volume, $path, '');
- $i++;
- }
- }
+ my $path = '';
+ foreach my $dir (@path) {
+ $path = catdir($path,$dir);
+ last unless -d catpath($volume, $path, '');
+ $i++;
+ }
+ }
$hd->filename(canonpath(catpath($volume, catdir(@path[0..$i]),
($i+1<@path?$path[$i+1]:''))));
- $hd->path_info(join("/",'',@path[($i+2)..$#path]));
- $hd->request_uri(substr($original_uri,0,- length($hd->path_info))) if
length($hd->path_info);
+ $hd->path_info(join("/",'',@path[($i+2)..$#path]));
+ $hd->request_uri(substr($original_uri,0,- length($hd->path_info))) if
length($hd->path_info);
$self->log(LOGDEBUG, "Translated $uri to " . $hd->filename .
" (request uri: " . $hd->request_uri . ", path info: " .
$hd->path_info . ")");
