Faz version of Yarn..

examples/yarn/lib/Yarn.pm

@@ -0,0 +1,89 @@
+use Web::Request;
+use Web::Response;
+use Faz::Application;
+use Faz::Dispatcher;
+use Faz::Action::Root;
+use Faz::Action::Chained;
+use Faz::Action::Public;
+use Tags;
+
+class Yarn is Faz::Application {
+  my sub get-posts() {
+    'data/posts' ~~ :f
+      ?? eval(slurp('data/posts')).list
+        !! ()
+  }
+
+  method setup {
+    $.dispatcher = Faz::Dispatcher.new;
+
+    my $root = Faz::Action::Root.new\
+      ( :private-name('(root)'),
+        :begin-closure({ %*stash<posts> = get-posts() }) );
+    $.register-action($root);
+
+    my $index = Faz::Action::Public.new\
+      ( :private-name('(root)/'),
+        :regex(/ $/),
+        :chained($root),
+        :execute-closure({
+           $*response.write(show {
+             html {
+               head { title { 'Yarn' } }
+                 body {
+                   p {
+                     a :href</create>, { 'Write a new post' }
+                     }
+                     for %*stash<posts> -> $post {
+                       div :class<post>, {
+                         h1 { $post<title> };
+                         div { $post<content> };
+                       }
+                     }
+                   }
+                 }
+               })
+        })
+      );
+    $.register-action($index);
+
+    my $create = Faz::Action::Public.new\
+      ( :private-name('(root)/create'),
+        :regex(/ create \/? $/),
+        :chained($root),
+        :execute-closure({
+           when $*request.GET<title> ne '' {
+             my $p = $*request.GET;
+             unless 'data' ~~ :d {
+               run('mkdir data');
+             }
+             %*stash<posts>.unshift( { title => $p<title>,
+                                       content => $p<content> } );
+             my $fh = open('data/posts', :w) or die $!;
+             $fh.print( %*stash<posts>.perl );
+             $fh.close;
+           }
+
+           $*response.write(show {
+             html { title { 'Writing a post' } }
+               body {
+                 form :action</create>, :method<get>, {
+                   p { input :name<title>, { '' } }
+                   p { textarea :name<content>, { '' } }
+                   p { input :type<submit>, { '' } }
+                 }
+               }
+           });
+        })
+      );
+    $.register-action($create);
+    $.dispatcher.compile;
+  }
+
+  method call($env) {
+    my Web::Request $req .= new($env);
+    my Web::Response $res .= new;
+    $.handle($req, $res);
+    $res.finish();
+  }
+}

examples/yarn/yarn.pl

@@ -0,0 +1,52 @@
+use v6;
+use HTTP::Daemon;
+use Yarn;
+defined @*ARGS[0] && @*ARGS[0] eq '--request' ?? request() !! daemon();
+
+my $yarn = Yarn.new;
+$yarn.setup;
+
+# Serve one page
+sub request($c) {
+    my $r = $c.get_request;
+    warn "{hhmm} {$r.req_method} {$r.url.path} {$r.header('User-Agent')}";
+    if $r.req_method eq 'GET' {
+        my $qs = $r.url.path ~~ / '?' (.*) $/
+                    ?? ~$0
+                    !! '';
+        $c.send_response(
+            ~([~] $yarn.call({"QUERY_STRING" => $qs}).[2])
+        );
+    }
+    elsif $r.req_method eq 'POST' {
+        my $qs = $r.url.path ~~ / '?' (.*) $/
+                    ?? ~$0
+                    !! '';
+        $c.send_response(
+            ~([~] $yarn.call({"REQUEST_METHOD" => 'POST',
+                             "QUERY_STRING" => $qs}).[2])
+        );
+    }
+    else {
+        warn "{hhmm} rejected {$r.req_method} {$r.url.path}";
+        $c.send_error('RC_FORBIDDEN');
+    }
+    warn ' '; # blank line
+}
+
+# Executed as main parent process with an endless loop that re-starts
+# netcat after every page request.
+sub daemon {
+    my HTTP::Daemon $d .= new( host=> '127.0.0.1', port=> 8765 );
+    say "Browse this Perl 6 (Rakudo) web server at {$d.url}";
+    $d.daemon();
+}
+
+# give the current time in hh:mm format
+sub hhmm {
+    my $t = int(time);
+    my $m = int( $t / 60 ) % 60;
+    my $h = int( $t / 3600 ) % 24;
+    my $hhmm = "{$h.fmt('%02d')}:{$m.fmt('%02d')}";
+    return $hhmm;
+}

lib/Faz/Application.pm

@@ -15,9 +15,10 @@ role Faz::Application {
      $*application = self;
      $*request = $request;
      $*response = $response;
-     self.*prepare;
-     self.*dispatch;
-     self.*finalize;
+     %*stash = ();
+     self.prepare;
+     self.dispatch;
+     self.finalize;
   };
 
 }

lib/Faz/Dispatcher.pm

@@ -55,7 +55,7 @@ role Faz::Dispatcher {
   }
 
   method dispatch() {
-    self.compile;
+    unless $!regex { self.compile; }
     if $*request.uri.path ~~ $!regex {
       my %named = %($<subrx><action_capture>);
       my @pos = @($<subrx><action_capture>);