Add controllers and api objects

lib/Prong.pm

@@ -3,4 +3,11 @@ our $VERSION = '0.00001';
 
 1;
 
-__END__
+__END__
+
+=head1 SYNOPSIS
+
+    ./script/prong_sandbox.pl \
+        --controller=+MyApp::Controller::Foo
+
+=cut

lib/Prong/API/Module.pm

@@ -0,0 +1,9 @@
+package Prong::API::Module;
+use Moose;
+use namespace::autoclean;
+
+with 'Prong::API::WithDBIC';
+
+__PACKAGE__->meta->make_immutable();
+
+1;

lib/Prong/API/ModuleContent.pm

@@ -0,0 +1,9 @@
+package Prong::API::ModuleContent;
+use Moose;
+use namespace::autoclean;
+
+with 'Prong::API::WithDBIC';
+
+__PACKAGE__->meta->make_immutable();
+
+1;

lib/Prong/API/WithDBIC.pm

@@ -0,0 +1,184 @@
+package Prong::API::WithDBIC;
+use Moose::Role;
+use namespace::autoclean;
+
+with
+    'Prong::Trait::WithDBIC' => {
+        -excludes => [ qw(_build_default_moniker) ],
+    },
+    'MooseX::WithCache' => {
+        backend => 'Cache::Memcached'
+    }
+;
+
+has primary_key => (
+    is => 'ro',
+    required => 1,
+    lazy_build => 1
+);
+
+has cache_prefix => (
+    is => 'ro',
+    required => 1,
+    lazy_build => 1,
+);
+
+sub _build_default_moniker {
+    my $self = shift;
+    return
+        ((blessed $self) =~ /^Prong::API::(.+)$/) ?
+        $1 :
+        ()
+    ;
+}
+
+sub _build_primary_key {
+    my $self = shift;
+    my $schema = $self->schema();
+    my $rs = $self->resultset();
+
+    my @pk = $rs->result_source->primary_columns;
+    return [ @pk ];
+}
+
+sub _build_cache_prefix {
+    my $self = shift;
+    return join('.', split(/\./, ref $self));
+}
+
+sub find {
+    my ($self, @id) = @_;
+
+    my $schema    = $self->schema();
+    my $cache_key = [$self->cache_prefix, @id ];
+    my $obj       = $self->cache_get($cache_key);
+    if ($obj) {
+        $obj = $schema->thaw($obj);
+    } else {
+        $obj = $self->resultset->find(@id);
+        if ($obj) {
+            $self->cache_set($cache_key, $schema->freeze($obj));
+        }
+    }
+    return $obj;
+}
+
+sub load_multi {
+    my ($self, @ids) = @_;
+
+    my $schema = $self->schema();
+
+    # keys is a bit of a hassle
+    my $rs = $self->resultset();
+    my @keys = map { [ $self->cache_prefix, ref $_ ? @$_ : $_ ] } @ids;
+    my $h = $self->cache_get_multi(@keys);
+
+    my @ret;
+    if ($h) {
+        my $results = $h->{results};
+        foreach my $key (@keys) {
+            if (my $got = $results->{$key}) {
+                push @ret, $schema->thaw($got);
+            } else {
+                push @ret, $self->find( ref $key->[1] ? @{$key->[1]} : $key->[1]);
+            }
+        }
+    } else {
+        @ret = map { $self->find($_) } @ids;
+    }
+
+    return wantarray ? @ret : \@ret;
+}
+
+
+sub search {
+    my ($self, $where, $attrs) = @_;
+
+    $attrs ||= {};
+
+    my $rs = $self->resultset();
+    my $pk = $self->primary_key();
+
+    $attrs->{select} ||= $pk;
+
+    my @rows = $rs->search($where, $attrs);
+    my @keys = map {
+        my $row = $_;
+        [ map { $row->$_ } @$pk ]
+    } @rows;
+
+    return $self->load_multi(@keys);
+}
+
+sub create {
+    my ($self, $args) = @_;
+    my $rs = $self->resultset();
+    return $rs->create($args);
+}
+
+sub update {
+    my ($self, $args) = @_;
+
+    my $schema = $self->schema();
+
+    my $pk = $self->primary_key();
+    my $rs = $self->resultset();
+    my $key = [ map { delete $args->{$_} } @$pk ];
+
+    my $guard = $schema->txn_scope_guard;
+
+    my $row = $self->find(@$key);
+    if ($row) {
+        while (my ($field, $value) = each %$args) {
+            if (! $row->can($field)) {
+                confess blessed $self . ": Attempt to update unknown column: $field";
+            }
+            $row->$field( $value );
+        }
+        $row->update;
+        $self->cache_del([ $self->cache_prefix, @$key ]);
+    }
+
+    $guard->commit;
+
+    return $row;
+}
+
+sub delete {
+    my ($self, @id) = @_;
+
+    my $schema = $self->schema();
+
+    my $guard = $schema->txn_scope_guard;
+    foreach my $id (@id) {
+        my @key = ref $id ? @$id : $id;
+        my $obj = $schema->resultset($self->resultset_moniker)->find(@key);
+        if ($obj) {
+            $obj->delete;
+        }
+
+        my $cache_key = [$self->cache_prefix, @key ];
+        $self->cache_del($cache_key);
+    }
+
+    $guard->commit;
+    return ();
+}
+
+sub all {
+    my $self = shift;
+
+    my $pk = $self->primary_key;
+
+    # Should optimize this!
+    my @all = $self->resultset->search(
+        {},
+        { select => $self->primary_key }
+    );
+    return $self->load_multi( map {
+        my $h = $_;
+        [ map { $h->$_ } @$pk ]
+    } @all);
+}
+
+1;

lib/Prong/Server/Gadget.pm

@@ -6,6 +6,17 @@ use Router::Simple;
 use Text::MicroTemplate::File;
 use namespace::autoclean;
 
+with qw(
+    Prong::Trait::WithAPI
+    Prong::Trait::WithDBIC
+);
+
+has controllers => (
+    is => 'ro',
+    isa => 'ArrayRef',
+    lazy_build => 1,
+);
+
 has router => (
     is => 'ro',
     isa => 'Router::Simple',
@@ -24,44 +35,64 @@ has schema => (
     required => 1,
 );
 
-sub _build_router {
+sub BUILD {
+    my $self = shift;
+    foreach my $controller (@{ $self->controllers }) {
+        $controller->register( $self );
+    }
+}
+
+sub _build_apis {
     my $self = shift;
 
-    my $router = Router::Simple->new();
-    $router->connect('/' => {
-        code => sub {
-            my $req = shift;
-            my @modules = $self->schema->resultset('Module')->search();
-            return [
-                200,
-                [ "Content-Type" => "text/html" ],
-                [ $self->template->render_file( 'index.mt', $req, { modules => \@modules } ) ]
-            ];
+    my %apis;
+    foreach my $module qw(Module ModuleContent) {
+        my $class = "Prong::API::$module";
+        if (! Class::MOP::is_class_loaded($class)) {
+            Class::MOP::load_class($class);
         }
-    } );
-
-    $router->connect('/app/{module_id}' => {
-        code => sub {
-            my ($req, $p) = @_;
-            my $content = $self->schema->resultset('ModuleContent')->search({
-                module_id => $p->{module_id},
-            })->single;
-            return [
-                200,
-                [ "Content-Type" => "text/html" ],
-                [ $self->template->render_file( 'app/view.mt', $req, { content => $content } ) ]
-            ];
+
+        $apis{ $module } = $class->new(schema => $self->schema, apis => \%apis);
+    }
+
+    return \%apis;
+}
+
+sub _build_controllers {
+    my $self = shift;
+
+    my @controllers;
+    foreach my $controller qw(Root Application) {
+        my $class = "Prong::Server::Gadget::Controller::$controller";
+        if (! Class::MOP::is_class_loaded( $class ) ) {
+            Class::MOP::load_class( $class );
         }
-    });
+        push @controllers, $class->new();
+    }
+    return \@controllers;
+}
+
+sub _build_router {
+    my $self = shift;
+    return Router::Simple->new();
+}
 
-    return $router;
+sub add_route {
+    my ($self, @args) = @_;
+    $self->router->connect(@args);
 }
 
 sub process {
     my ($self, $env) = @_;
 
     if (my $p = $self->router->match( $env )) {
-        return $p->{code}->( Plack::Request->new( $env ), $p );
+        my $controller = $p->{controller};
+        my $action     = $p->{action};
+        my $res = $controller->$action( Plack::Request->new( $env ), $p );
+        return (blessed $res) ?
+            $res->finalize() :
+            $res
+        ;
     }
 
     return [ 404, [], [ 'Not Found' ] ];

lib/Prong/Server/Gadget/Controller.pm

@@ -0,0 +1,23 @@
+package Prong::Server::Gadget::Controller;
+use Moose;
+use namespace::autoclean;
+
+with 'Prong::Trait::WithAPI';
+
+has template => (
+    is => 'rw',
+    isa => 'Text::MicroTemplate::File',
+    handles => {
+        render => 'render_file',
+    }
+);
+
+sub register {
+    my ($self, $server) = @_;
+    $self->apis( $server->apis );
+    $self->template( $server->template );
+}
+
+__PACKAGE__->meta->make_immutable();
+
+1;

lib/Prong/Server/Gadget/Controller/Application.pm

@@ -0,0 +1,29 @@
+package Prong::Server::Gadget::Controller::Application;
+use Moose;
+use namespace::autoclean;
+
+extends 'Prong::Server::Gadget::Controller';
+
+sub register {
+    my ($self, $server) = @_;
+    $server->add_route('/app/{module_id}' => { controller => $self, action => 'view' } );
+}
+
+sub view {
+    my ($self, $req, $p) = @_;
+
+    my ($content) = $self->api('ModuleContent')->search({
+        module_id => $p->{module_id}
+    });
+
+    return $req->new_response(
+        200,
+        [ "Content-Type" => "text/html" ],
+        $self->render( 'app/view.mt', $req, { content => $content } )
+    );
+}
+
+__PACKAGE__->meta->make_immutable();
+
+1;
+