Permalink
Browse files

first dispatch working

  • Loading branch information...
1 parent 756763b commit d821fc23cbe3ada33074e58aa918b407b3a40858 @moritz committed Jun 26, 2010
Showing with 29 additions and 6 deletions.
  1. +21 −1 lib/CGI/Application.pm
  2. +8 −5 t/basic.t
View
22 lib/CGI/Application.pm
@@ -7,6 +7,8 @@ has $.start-mode is rw = 'start';
has $.header-type is rw = 'header';
has $.mode-param is rw = 'rm';
+has $.error-mode is rw;
+
has $.current-runmode is rw;
# the CGI object or hash
@@ -48,8 +50,26 @@ multi method __get_runmode($rm-param) {
return $rm;
}
+multi method __get_runmeth($rm) {
+ my $m = %.run-modes{$rm};
+ # TODO: implement AUTOLOAD/CANDO mode
+ die "No such run mode '$rm'\n" unless defined $m;
+ return $m;
+}
+
multi method __get_body($rm) {
- 'BODY';
+ my $method-name = $.__get_runmeth($rm);
+ my $body = try { self."$method-name"() };
+ if $! {
+ my $error = $!;
+ $.call-hook('error', $error);
+ if $.error-mode {
+ $body = self."$.error-mode"();
+ } else {
+ die "Error executing run mode '$rm': $error";
+ }
+ }
+ return $body;
}
multi method _send_headers() {
View
13 t/basic.t
@@ -16,10 +16,11 @@ use CGI::Application;
sub response-like($app, Mu $header, Mu $body, $comment) {
my $output = $app.run;
- diag "Output: " ~ $output.perl;
- my ($h, $b) = $output.split("\r\n\r\n");
- ok ?($h ~~ $header), "$comment (header)";
- ok ?($b ~~ $body), "$comment (body)";
+ my @hb = $output.split(rx{\r?\n\r?\n});
+# diag "Header: @hb[0]";
+# diag "Body: @hb[1]";
+ ok ?(@hb[0] ~~ $header), "$comment (header)";
+ ok ?(@hb[1] ~~ $body), "$comment (body)";
}
{
@@ -29,9 +30,11 @@ sub response-like($app, Mu $header, Mu $body, $comment) {
$app.query = {};
response-like($app,
rx{^ 'Content-Type: text/html'},
- rx{ 'Query Parameters:' },
+ rx{ 'Query parameters:' },
'base class response',
);
}
done_testing;
+
+# vim: ft=perl6

0 comments on commit d821fc2

Please sign in to comment.