[Bast-commits] r3326 - in trunk/Anything/lib/Anything: . Controller
Controller/Test Model Model/Action UI UI/ActionForm View
castaway at dev.catalyst.perl.org
castaway at dev.catalyst.perl.org
Fri May 18 23:15:18 GMT 2007
Author: castaway
Date: 2007-05-18 23:15:17 +0100 (Fri, 18 May 2007)
New Revision: 3326
Added:
trunk/Anything/lib/Anything/Controller/Test.pm
trunk/Anything/lib/Anything/Controller/Test/
trunk/Anything/lib/Anything/Controller/Test/Item.pm
trunk/Anything/lib/Anything/Model/Action/
trunk/Anything/lib/Anything/Model/Action/CreateItem.pm
trunk/Anything/lib/Anything/Model/Action/CreateItems.pm
trunk/Anything/lib/Anything/Model/Action/ViewItem.pm
trunk/Anything/lib/Anything/Model/Action/ViewItems.pm
trunk/Anything/lib/Anything/UI/
trunk/Anything/lib/Anything/UI/ActionForm/
trunk/Anything/lib/Anything/UI/ActionForm/Item.pm
trunk/Anything/lib/Anything/View/XHTML.pm
Log:
Initial reactionising with ActionReflector
Added: trunk/Anything/lib/Anything/Controller/Test/Item.pm
===================================================================
--- trunk/Anything/lib/Anything/Controller/Test/Item.pm (rev 0)
+++ trunk/Anything/lib/Anything/Controller/Test/Item.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,114 @@
+package Anything::Controller::Test::Item;
+
+use strict;
+use warnings;
+use base 'Reaction::UI::CRUDController';
+use Reaction::Class;
+use Anything::UI::ActionForm::Item;
+
+__PACKAGE__->config(
+ model_base => 'Anything',
+ model_name => 'Items',
+# ActionForm_class => 'Anything::UI::ActionForm::Item',
+ action => { base => { Chained => '/test/base', PathPart => 'item' } }
+ );
+
+sub get_collection {
+ my ($self, $c, $typeid) = @_;
+ my $model = $c->model(join('::', $self->model_base, $self->model_name));
+ if(defined $typeid)
+ {
+ $model = $model->search({ TypeID => $typeid });
+# $model = $model->TypeID;
+ }
+ return $model;
+}
+
+sub get_model_action {
+ my ($self, $c, $name, $target, $typeid) = @_;
+
+ if ($target->can('action_for')) {
+ return $target->action_for($name, ctx => $c);
+ }
+ my $target_type = $target->related_resultset('TypeID')->find({ID => $typeid});
+ my $model_name = "Action::${name}".$self->model_name;
+ my $model = $c->model($model_name);
+ confess "no such Model $model_name" unless $model;
+ return $model->new(target_model => $target,
+ target_type => $target_type,
+ ctx => $c);
+}
+
+# around get_model_action => sub {
+# my $super = shift;
+# my ($self, $c, $name, $target, $typeid) = @_;
+
+# my $model = $super->(@_);
+# $typeid ||= $model->target_model->TypeID->ID;
+# my $tmodel = $model->target_model->result_source->schema->resultset('Type')->find($typeid);
+
+# # {
+# local $SIG{__DIE__} = sub {
+# print STDERR Carp::longmess;
+# print STDERR join " // ", @_;
+# exit;
+# };
+# # sub undestroyable::DESTROY {
+# # print STDERR Carp::longmess;
+# # exit;
+# # }
+# # die bless {}, "undestroyable";
+# # $c->log->info("Tmodel is ", ref($tmodel) . " (" . $tmodel->typefields->count . ")");
+# # }
+# $c->log->info("model is ", ref($model));
+# foreach my $val ($tmodel->typefields->all)
+# {
+# # has 'Some Attribute' => ( isa => 'ArrayRef', writer => sub { shift->value('Some Attribute', @_) }, is => 'rw', required => ?? );
+# $c->log->debug("Adding attribute: " . $val->FieldID->Name . " ( isa => 'ArrayRef', is => 'rw', writer => sub { shift->value($val->FieldID->Name, @_) }, required => 1)");
+# $model->meta->add_attribute($val->FieldID->Name,
+# ( isa => 'ArrayRef', is => 'rw', writer => { 'set_value' => sub { shift->value($val->FieldID->Name, @_) } }, required => 0)
+# );
+
+# }
+
+# return $model;
+# };
+
+sub list :Chained('base') :PathPart('') :Args() {
+ my ($self, $c, $typeid) = @_;
+
+ $self->push_viewport(
+ $self->ListView_class,
+ collection => $self->get_collection($c, $typeid),
+ exclude_columns => [qw/Created Modified/],
+ column_order => [qw/Name Description/],
+ );
+}
+
+sub create :Chained('base') :PathPart('create') :Args() {
+ my ($self, $c, $typeid) = @_;
+ my $action = $self->get_model_action($c, 'Create', $self->get_collection($c), $typeid);
+ $self->push_viewport(
+ 'Anything::UI::ActionForm::Item', # $self->ActionForm_class,
+ action => $action,
+ next_action => 'list',
+ on_apply_callback => sub { $self->after_create_callback($c => @_); },
+ column_order => [qw/Name Description/],
+ );
+}
+
+sub view :Chained('object') :Args() {
+ my ($self, $c) = @_;
+ my $object :Stashed;
+ my $action = $self->get_model_action($c, 'View', $object);
+ my @cap = @{$c->req->captures};
+ pop(@cap); # object id
+ $self->push_viewport(
+ $self->ObjectView_class,
+ action => $action,
+ column_order => [qw/Name Description/],
+ );
+}
+
+1;
+
Added: trunk/Anything/lib/Anything/Controller/Test.pm
===================================================================
--- trunk/Anything/lib/Anything/Controller/Test.pm (rev 0)
+++ trunk/Anything/lib/Anything/Controller/Test.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,26 @@
+package Anything::Controller::Test;
+
+use strict;
+use warnings;
+use base 'Reaction::UI::RootController';
+use Reaction::Class;
+
+use aliased 'Reaction::UI::ViewPort';
+use aliased 'Reaction::UI::ViewPort::ListView';
+use aliased 'Reaction::UI::ViewPort::ActionForm';
+
+# __PACKAGE__->config->{namespace} = '';
+
+sub base :Chained('/') :PathPart('test') :CaptureArgs(0) {
+ my ($self, $c) = @_;
+
+ $self->push_viewport(ViewPort, layout => 'xhtml');
+}
+
+sub root :Chained('base') :PathPart('') :Args(0) {
+ my ($self, $c) = @_;
+
+ $self->push_viewport(ViewPort, layout => 'index');
+}
+
+1;
Added: trunk/Anything/lib/Anything/Model/Action/CreateItem.pm
===================================================================
--- trunk/Anything/lib/Anything/Model/Action/CreateItem.pm (rev 0)
+++ trunk/Anything/lib/Anything/Model/Action/CreateItem.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,20 @@
+package Anything::Model::Action::CreateItem;
+
+use Reaction::Class;
+use DB::Anything;
+extends 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create';
+
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ActionReflector';
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create'
+ => 'DBIC_Create';
+
+class CreateItem, is DBIC_Create, which
+{
+ my $r = ActionReflector->new;
+ $r->reflect_attrs( 'DB::Anything::Items', CreateItem, qw/Name Description/);
+};
+
+# has 'Some Attribute' => ( isa => 'ArrayRef', writer => sub { shift->value('Some Attribute', @_) }, is => 'rw', required => ?? );
+# using ArrayRef delays the setting until after the base item is created.
+
+1;
Added: trunk/Anything/lib/Anything/Model/Action/CreateItems.pm
===================================================================
--- trunk/Anything/lib/Anything/Model/Action/CreateItems.pm (rev 0)
+++ trunk/Anything/lib/Anything/Model/Action/CreateItems.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,61 @@
+package Anything::Model::Action::CreateItems;
+
+use Reaction::Class;
+use DB::Anything;
+# extends 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create';
+
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ActionReflector';
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create'
+ => 'DBIC_Create';
+
+class CreateItems, is DBIC_Create, which
+{
+ has 'target_type' => (isa => 'DBIx::Class::Row', is => 'rw', required => 0, metaclass => 'Reaction::Meta::Attribute');
+
+ my $r = ActionReflector->new;
+ $r->reflect_attrs( 'DB::Anything::Items', CreateItems, qw/Name Description/);
+ implements BUILD => as {
+ my ($self, $args) = @_;
+
+# my $tmodel;
+# if($self->target_model->isa('DB::Anything::Type'))
+# {
+# my $tmodel = $self->target_model;
+# }
+# my $tmodel = $self->target_model->TypeID;
+ (my $tname = $self->target_type->Name) =~ s/\s//g;
+ my $action_class = __PACKAGE__ . '::' . $tname;
+ my $str = "package ${action_class};\nuse Reaction::Class;\n";
+ eval $str;
+ confess "Error making ${action_class} a Reaction class: $@" if $@;
+ warn $str if $ENV{REACTION_DEBUG};
+
+ my $super = [ DBIC_Create ];
+ $action_class->can('extends')->(@$super);
+ warn "extends ".join(', ', map { "'$_'" } @$super).";\n"
+ if $ENV{REACTION_DEBUG};
+
+ my $r = ActionReflector->new;
+ $r->reflect_attrs( 'DB::Anything::Items', $action_class, qw/Name Description/);
+
+ foreach my $val ($self->target_type->typefields->all)
+ {
+ $self->ctx->log->debug("Adding attribute: " . $val->FieldID->Name . " ( isa => '" . $val->FieldID->TypeID->Name . "', is => 'rw', writer => sub { shift->value($val->FieldID->Name, @_) }, required => 1)");
+ $action_class->meta->_process_attribute($val->FieldID->Name,
+ ( isa => $val->TypeID->Name, is => 'rw', writer => { 'set_value' => sub { shift->value($val->FieldID->Name, @_) } }, required => 0)
+ );
+
+ }
+
+ my $action = $action_class->new(target_model => $self->target_model,
+ ctx => $self->ctx);
+ return $action;
+ };
+
+};
+
+
+# has 'Some Attribute' => ( isa => 'ArrayRef', writer => sub { shift->value('Some Attribute', @_) }, is => 'rw', required => ?? );
+# using ArrayRef delays the setting until after the base item is created.
+
+1;
Added: trunk/Anything/lib/Anything/Model/Action/ViewItem.pm
===================================================================
--- trunk/Anything/lib/Anything/Model/Action/ViewItem.pm (rev 0)
+++ trunk/Anything/lib/Anything/Model/Action/ViewItem.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,20 @@
+package Anything::Model::Action::ViewItems;
+
+use Reaction::Class;
+use DB::Anything;
+extends 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create';
+
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ActionReflector';
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create'
+ => 'DBIC_Create';
+
+class ViewItems, is DBIC_Create, which
+{
+ my $r = ActionReflector->new;
+ $r->reflect_attrs( 'DB::Anything::Items', ViewItems, qw/Name Description/);
+};
+
+# has 'Some Attribute' => ( isa => 'ArrayRef', writer => sub { shift->value('Some Attribute', @_) }, is => 'rw', required => ?? );
+# using ArrayRef delays the setting until after the base item is created.
+
+1;
Added: trunk/Anything/lib/Anything/Model/Action/ViewItems.pm
===================================================================
--- trunk/Anything/lib/Anything/Model/Action/ViewItems.pm (rev 0)
+++ trunk/Anything/lib/Anything/Model/Action/ViewItems.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,20 @@
+package Anything::Model::Action::ViewItems;
+
+use Reaction::Class;
+use DB::Anything;
+extends 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create';
+
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ActionReflector';
+use aliased 'Reaction::InterfaceModel::Action::DBIC::Result::View'
+ => 'DBIC_View';
+
+class ViewItems, is DBIC_View, which
+{
+ my $r = ActionReflector->new;
+ $r->reflect_attrs( 'DB::Anything::Items', ViewItems, qw/Name Description/);
+};
+
+# has 'Some Attribute' => ( isa => 'ArrayRef', writer => sub { shift->value('Some Attribute', @_) }, is => 'rw', required => ?? );
+# using ArrayRef delays the setting until after the base item is created.
+
+1;
Added: trunk/Anything/lib/Anything/UI/ActionForm/Item.pm
===================================================================
--- trunk/Anything/lib/Anything/UI/ActionForm/Item.pm (rev 0)
+++ trunk/Anything/lib/Anything/UI/ActionForm/Item.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,20 @@
+package Anything::UI::ActionForm::Item;
+
+use Reaction::Class;
+# extends 'Reaction::UI::ViewPort::ActionForm';
+use aliased 'Reaction::UI::ViewPort::Field::Text';
+use aliased 'Reaction::UI::ViewPort::Field::DateTime';
+
+class Item is 'Reaction::UI::ViewPort::ActionForm', which {
+
+ implements build_fields_for_type_TextField => as {
+ my ($self, $attr, $args) = @_;
+ return $self->build_simple_field(Text, $attr, $args);
+ };
+
+ implements build_fields_for_type_DateField => as {
+ my ($self, $attr, $args) = @_;
+ return $self->build_simple_field(DateTime, $attr, $args);
+ };
+};
+1;
Added: trunk/Anything/lib/Anything/View/XHTML.pm
===================================================================
--- trunk/Anything/lib/Anything/View/XHTML.pm (rev 0)
+++ trunk/Anything/lib/Anything/View/XHTML.pm 2007-05-18 22:15:17 UTC (rev 3326)
@@ -0,0 +1,17 @@
+package Anything::View::XHTML;
+
+use Reaction::Class;
+
+extends 'Reaction::UI::Renderer::XHTML';
+
+__PACKAGE__->config({
+ CATALYST_VAR => 'ctx',
+ RECURSION => 1,
+ INCLUDE_PATH => [Anything->path_to('root'),
+ Anything->path_to('root/base'),
+ Anything->path_to('root/reaction'),
+ ],
+});
+
+
+1;
More information about the Bast-commits
mailing list