[Rt-commit] r2554 - in experiments/Bamboo/ex/trivial: html lib t

[autrijus at bestpractical.com]

Author: autrijus
Date: Fri Apr  1 05:28:19 2005
New Revision: 2554

Added:
   experiments/Bamboo/ex/trivial/html/
   experiments/Bamboo/ex/trivial/html/Counter.html
   experiments/Bamboo/ex/trivial/html/autohandler
Modified:
   experiments/Bamboo/ex/trivial/lib/Counter.pm
   experiments/Bamboo/ex/trivial/t/2facade.t
Log:
* add the simple but working operation-stream based Counter webapp in mason

Added: experiments/Bamboo/ex/trivial/html/Counter.html
==============================================================================
--- (empty file)
+++ experiments/Bamboo/ex/trivial/html/Counter.html	Fri Apr  1 05:28:19 2005
@@ -0,0 +1,17 @@
+%# View
+Current counter is <% $::c->{cnt}->get('value') %>.
+
+<form method="post">
+<input name="<% $::c->{cnt}->call('reset') %>"
+       type="hidden">
+<input name="<% $::c->{cnt}->call('increment') %>"
+       type="hidden">
+<input name="<% $::c->{cnt}->call('increment') %>"
+       type="submit"
+       value="reset counter">
+</form>
+
+%# Action
+<%ATTR>
+Operations => [ 'new Counter cnt', 'call cnt increment' ]
+</%ATTR>

Added: experiments/Bamboo/ex/trivial/html/autohandler
==============================================================================
--- (empty file)
+++ experiments/Bamboo/ex/trivial/html/autohandler	Fri Apr  1 05:28:19 2005
@@ -0,0 +1,100 @@
+<%PERL>
+# Controller
+Controller->run( $m->fetch_next->attr('Operations') );
+Controller->run( Controller->extract(\%ARGS) );
+$m->call_next; $m->abort;
+</%PERL>
+
+<%INIT>
+# Model
+{
+    package Bamboo;
+    our $VERSION = '0.01';
+
+    package View;
+
+    sub new {
+        my $class = shift;
+        my %attrs = @_;
+        return bless(\%attrs, $class);
+    }
+
+    sub it      { $_[0]{it} }
+    sub label   { $_[0]{label} }
+    sub class   { ref $_[0]{it} }
+
+    sub get {
+        my ($self, $attr) = @_;
+        $self->it->{$attr};
+    }
+
+    sub call {
+        my ($self, $meth) = @_;
+        $::seq++;
+        join('-' => 'Bamboo', Bamboo->VERSION, $::seq, "call", $self->class, $self->label, $meth); 
+    }
+
+    package Controller;
+
+    sub extract {
+        my ($self, $args) = @_;
+        
+        my $ws = qr/[^-]+/;
+        my @ops;
+
+        foreach my $key (sort keys %$args) {
+            $key =~ /^Bamboo-$Bamboo::VERSION-\d+-(.+?)-($ws)-($ws)-($ws)/ or next;
+            my ($op, $class, $label, $arg) = ($1, $2, $3, $4);
+            push @ops, "$op $label $arg";
+        }
+
+        return \@ops;
+    }
+
+    sub run {
+        my ($self, $ops) = @_;
+        foreach my $op (@$ops) {
+            if ($op =~ /new (\S+) (\S+)/) {
+                my ($class, $label) = ($1, $2);
+                $::c->{$label} = View->new(
+                    it      => $class->new,
+                    label   => $label,
+                );
+            }
+            elsif ($op =~ /call (\S+) (\S+)/) {
+                my ($label, $meth) = ($1, $2);
+                $::c->{$label}->it->$meth;
+            }
+        }
+    }
+
+    package Counter;
+
+    use YAML;
+    use HTTP::Status;
+    use fields qw( value );
+
+    sub new {
+        my $self = fields::new(shift);
+
+        $self->{value} = eval {
+            YAML::LoadFile('/tmp/counter.cnt')
+        } || 0;
+
+        return $self;
+    }
+
+    sub increment {
+        my $self = shift;
+        YAML::DumpFile('/tmp/counter.cnt' => (++$self->{value}));
+        return RC_OK;
+    }
+
+    sub reset {
+        my $self = shift;
+        YAML::DumpFile('/tmp/counter.cnt' => ($self->{value} = 0));
+        return RC_OK;
+    }
+}
+
+</%INIT>

Modified: experiments/Bamboo/ex/trivial/lib/Counter.pm
==============================================================================
--- experiments/Bamboo/ex/trivial/lib/Counter.pm	(original)
+++ experiments/Bamboo/ex/trivial/lib/Counter.pm	Fri Apr  1 05:28:19 2005
@@ -1,3 +1,5 @@
+package Counter;
+
 use strict;
 use warnings;
 use YAML;

Modified: experiments/Bamboo/ex/trivial/t/2facade.t
==============================================================================
--- experiments/Bamboo/ex/trivial/t/2facade.t	(original)
+++ experiments/Bamboo/ex/trivial/t/2facade.t	Fri Apr  1 05:28:19 2005
@@ -2,6 +2,9 @@
 
 use warnings;
 use strict;
+use FindBin qw<$Bin>;
+use lib "$Bin/../lib", "$Bin/../../lib", "$Bin/../../../lib";
+
 use Test::More qw/no_plan/;
 use_ok('Bamboo::Facade::Counter');