Permalink
Browse files

not quite dispatching yet

  • Loading branch information...
1 parent 0d648f3 commit 756763b79e46e0f1fcdf356b437ce20fe67366e7 @moritz committed Jun 26, 2010
Showing with 67 additions and 5 deletions.
  1. +61 −4 lib/CGI/Application.pm
  2. +6 −1 t/basic.t
View
@@ -1,11 +1,68 @@
class CGI::Application;
-has %.run-modes is rw;
-has $.start-mode is rw = 'start';
-has %.mode-param is rw;
+# XXX: should be dump-html
+has %.run-modes is rw = (start => 'dump');
+has $.start-mode is rw = 'start';
+has $.header-type is rw = 'header';
+has $.mode-param is rw = 'rm';
+
+has $.current-runmode is rw;
+
+# the CGI object or hash
has %.query is rw;
-multi method run() { "HEADER\r\n\r\nBODY" }
+multi method run() {
+ my $rm = $.__get_runmode($.mode-param);
+ $.current-runmode = $rm;
+
+ # undefine $.__PRERUN_MODE_LOCKED;
+ # $.call-hook('prerun', $rm);
+ # $.__PRERUN_MODE_LOCKED = 1
+ # my $prerun-mode = $.prerun-mode;
+ # if $prerun-mode {
+ # $rm = $prerun-mode;
+ # $.current-runmode = $rm;
+ # }
+
+ my $body = $.__get_body($rm);
+
+ # $.call-hook('postrun', $body);
+
+ my $headers = $._send_headers();
+
+ my $output = $headers ~ $body;
+
+ print $output unless $*CGI_APP_RETURN_ONLY || %*ENV<CGI_APP_RETURN_ONLY>;
+ return $output;
+
+}
+
+multi method __get_runmode($rm-param) {
+ my $rm = do given $rm-param {
+ when Callable { .(self) }
+ when Hash { .<run-mode> }
+ default { $.query{$_} }
+ }
+ $rm = $.start-mode unless defined($rm) && $rm.chars;
+ return $rm;
+}
+
+multi method __get_body($rm) {
+ 'BODY';
+}
+
+multi method _send_headers() {
+ "Content-Type: text/html\r\n\r\n";
+}
+
+multi method dump() {
+ [~] gather {
+ take "Runmode: '$.current-runmode'\n" if defined $.current-runmode;
+ take "Query parameters: %.query.perl()\n";
+ # TODO: dump %*ENV
+ }
+
+}
# vim: ft=perl6
View
@@ -5,13 +5,18 @@ plan *;
#%*ENV<CGI_APP_RETURN_ONLY> = 1;
+# RAKUDO workaround:
+# setting ENV variables fails (WTF?), so let's use a dynamic variable instead
+my $*CGI_APP_RETURN_ONLY = 1;
+
BEGIN { @*INC.push('t/lib', 'lib') };
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)";
@@ -24,7 +29,7 @@ sub response-like($app, Mu $header, Mu $body, $comment) {
$app.query = {};
response-like($app,
rx{^ 'Content-Type: text/html'},
- rx{ 'Query Environment' },
+ rx{ 'Query Parameters:' },
'base class response',
);
}

0 comments on commit 756763b

Please sign in to comment.