Permalink
Browse files

Faz version of Yarn..

  • Loading branch information...
1 parent 1a097ef commit d8a827e8a879518070983aa3d703bb24fb00c6d8 @ruoso committed May 12, 2009
Showing with 146 additions and 4 deletions.
  1. +89 −0 examples/yarn/lib/Yarn.pm
  2. +52 −0 examples/yarn/yarn.pl
  3. +4 −3 lib/Faz/Application.pm
  4. +1 −1 lib/Faz/Dispatcher.pm
View
@@ -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();
+ }
+}
View
@@ -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;
+}
View
@@ -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;
};
}
View
@@ -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>);

0 comments on commit d8a827e

Please sign in to comment.