[Bast-commits] r3347 - in trunk/Anything/lib/Anything: . InterfaceModel InterfaceModel/Action InterfaceModel/Items InterfaceModel/Items/Action Model

castaway at dev.catalyst.perl.org castaway at dev.catalyst.perl.org
Mon May 21 21:21:45 GMT 2007


Author: castaway
Date: 2007-05-21 21:21:44 +0100 (Mon, 21 May 2007)
New Revision: 3347

Added:
   trunk/Anything/lib/Anything/InterfaceModel/
   trunk/Anything/lib/Anything/InterfaceModel/Action/
   trunk/Anything/lib/Anything/InterfaceModel/Action/Create.pm
   trunk/Anything/lib/Anything/InterfaceModel/Items.pm
   trunk/Anything/lib/Anything/InterfaceModel/Items/
   trunk/Anything/lib/Anything/InterfaceModel/Items/Action/
   trunk/Anything/lib/Anything/InterfaceModel/Items/Action/Create.pm
   trunk/Anything/lib/Anything/InterfaceModel/Type.pm
   trunk/Anything/lib/Anything/Model/Domain.pm
   trunk/Anything/lib/Anything/Model/Domain/
   trunk/Anything/lib/Anything/Types.pm
Log:
New InterfaceModel reactionising stuff


Added: trunk/Anything/lib/Anything/InterfaceModel/Action/Create.pm
===================================================================
--- trunk/Anything/lib/Anything/InterfaceModel/Action/Create.pm	                        (rev 0)
+++ trunk/Anything/lib/Anything/InterfaceModel/Action/Create.pm	2007-05-21 20:21:44 UTC (rev 3347)
@@ -0,0 +1,58 @@
+package Anything::InterfaceModel::Items::Action::Create;
+
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create' => 'DBIC_Create';
+
+class Create is DBIC_Create, which {
+
+  has delayed_fields =>
+    (is => 'rw', isa => 'HashRef', required => 1,
+     default => sub{{}}, metaclass => 'Reaction::Meta::Attribute');
+
+  around 'new' => as {
+    my $super = shift;
+    my $self = shift;
+    my $class = ref $self || $self;
+    my %args = @_;
+
+    return $super->($self, @_) if $self->meta->is_anon_class;
+    my $action_meta = $self->meta->create_anon_class(superclasses => [$class]);
+
+    for my $val ($args{target_type}->typefields->all){
+      my $attr_name = $val->FieldID->Name;
+      $attr_name =~ s/ /_/g;  #TODO FIX FOR POSSIBLE COLLISIONS WHEN USING UNDERSCORES
+      $self->delayed_fields->{$attr_name} = $val;
+
+      $action_meta->add_attribute
+        ($attr_name,
+         reader => 'get_field_{$attr_name}',
+         writer => 'set_field_{$attr_name}',
+         is => 'rw',
+         isa => $val->TypeID->Name, #this will need fixing still
+         predicate => "has_field_${attr_name}"
+         required => 0
+        );
+    }
+
+    return $action_meta->new_object(@_);
+
+  };
+
+  around do_apply => sub {
+    my $super = shift;
+    my $row = $super->(@_);
+    my $self = shift;
+
+    for my $name (keys %{ $self->delayed_fields }) {
+      my $attr = $self->meta->find_attribute_by_name($name);
+      my $reader = $attr->reader;
+      my $predicate = $attr->predicate;
+      next if defined($predicate) && !$self->$predicate;
+      my $field = $self->delayed_fields->{$name};
+      $row->value($field->Name, $self->$reader);
+    }
+
+    return $row;
+  };
+};
+
+1;

Added: trunk/Anything/lib/Anything/InterfaceModel/Items/Action/Create.pm
===================================================================
--- trunk/Anything/lib/Anything/InterfaceModel/Items/Action/Create.pm	                        (rev 0)
+++ trunk/Anything/lib/Anything/InterfaceModel/Items/Action/Create.pm	2007-05-21 20:21:44 UTC (rev 3347)
@@ -0,0 +1,60 @@
+package Anything::InterfaceModel::Items::Action::Create;
+
+use Reaction::Class;
+use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create' => 'DBIC_Create';
+use Anything::Types;
+
+class Create is DBIC_Create, which {
+
+  has delayed_fields =>
+    (is => 'rw', isa => 'HashRef', required => 1,
+     default => sub{{}}, metaclass => 'Reaction::Meta::Attribute');
+
+  around 'new' => sub {
+    my $super = shift;
+    my $self = shift;
+    my $class = ref $self || $self;
+    my %args = @_;
+
+    return $super->($self, @_) if $self->meta->is_anon_class;
+    my $action_meta = $self->meta->create_anon_class(superclasses => [$class]);
+
+    for my $val ($args{target_type}->typefields->all){
+      my $attr_name = $val->FieldID->Name;
+      $attr_name =~ s/ /_/g;  #TODO FIX FOR POSSIBLE COLLISIONS WHEN USING UNDERSCORES
+      $self->delayed_fields->{$attr_name} = $val;
+
+      $action_meta->add_attribute
+        ($attr_name,
+         reader => 'get_field_{$attr_name}',
+         writer => 'set_field_{$attr_name}',
+         is => 'rw',
+         isa => $val->TypeID->Name, #this will need fixing still
+         predicate => "has_field_${attr_name}",
+         required => 0
+        );
+    }
+
+    return $action_meta->new_object(@_);
+
+  };
+
+  around do_apply => sub {
+    my $super = shift;
+    my $row = $super->(@_);
+    my $self = shift;
+
+    for my $name (keys %{ $self->delayed_fields }) {
+      my $attr = $self->meta->find_attribute_by_name($name);
+      my $reader = $attr->reader;
+      my $predicate = $attr->predicate;
+      next if defined($predicate) && !$self->$predicate;
+      my $field = $self->delayed_fields->{$name};
+      $row->value($field->Name, $self->$reader);
+    }
+
+    return $row;
+  };
+};
+
+1;

Added: trunk/Anything/lib/Anything/InterfaceModel/Items.pm
===================================================================
--- trunk/Anything/lib/Anything/InterfaceModel/Items.pm	                        (rev 0)
+++ trunk/Anything/lib/Anything/InterfaceModel/Items.pm	2007-05-21 20:21:44 UTC (rev 3347)
@@ -0,0 +1,92 @@
+package Anything::InterfaceModel::Items;
+
+use Reaction::InterfaceModel::DBIC::ObjectClass;
+use Anything::InterfaceModel::Items::Action::Create;
+
+class Items, which{
+
+  domain_model '_items_store' =>
+    (isa => 'DB::Anything::Items', inflate_result => 1,handles => ['display_name'],
+     reflect => [qw/ID Name Description/, [TypeID => 
+                 'Anything::InterfaceModel::Type' ]]);
+
+  reflect_actions
+    (
+#     Create => { attrs =>[qw(Name Description)] },
+     Update => { attrs =>[qw(Name Description)] },
+     Delete => {},
+    );
+
+# implements 'action_for' => as {
+#     my ($self, $action, %args) = @_;
+#     my $super = $self->_action_class_for($action);
+#     %args = (
+#              %{$self->_default_action_args_for($action)},
+#              %args,
+#              %{$self->_override_action_args_for($action)},
+#              );
+
+#     (my $tname = $args{target_type}->Name) =~ s/\s//g;
+# #    my $action_class = "${super}::${tname}";
+#     my $action_meta = $super->meta->create_anon_class(superclasses => [$super]);
+# #    my $action_meta = $super->meta->create($action_class, superclasses => [$super]);
+    
+#     my $attr_field_map = {};
+#     for my $val ($args{target_type}->typefields->all){
+#         my $attr_name = $val->FieldID->Name;
+#         $attr_name =~ s/ /_/g;  #TODO FIX FOR POSSIBLE COLLISIONS WHEN USING UNDERSCORES
+#         $attr_field_map->{$attr_name} = $val;
+        
+#         $action_meta->add_attribute
+#             ($attr_name,
+#              reader => 'get_field_{$attr_name}',
+#              writer => 'set_field_{$attr_name}',
+#              is => 'rw',
+#              isa => $val->TypeID->Name, #this will need fixing still
+#              predicate => "has_field_${attr_name}",
+#              required => 0
+#              );
+#     }
+
+#     my $new_parameter_hashref = sub{
+#         my $super = shift;
+#         my $self = shift;
+#         my $args = $super->($self);
+        
+#         for (keys %$args){
+#             delete $args->{$_} if exists $attr_field_map->{$_};
+#         }
+
+#         return $args;
+#     };
+
+#     $action_meta->add_around_method_modifier
+#         ('parameter_hashref', $new_parameter_hashref);
+    
+#     my $new_do_apply = sub{
+#         my $super = shift;
+#         my $self = shift;
+#         my $row = $super->($self);
+#         return unless $row;
+        
+#         my @delayed_fields = grep {exists $attr_field_map->{$_->name} }
+#         $self->parameter_attributes;
+        
+#         foreach my $attr (@delayed_fields) {
+#             my $reader = $attr->reader;
+#             my $predicate = $attr->predicate;
+#             next if defined($predicate) && !$self->$predicate;
+#             my $field = $attr_field_map->{$attr->name};
+#             $row->value($field->Name, $self->$reader);
+#         }
+
+#     };
+
+#     $action_meta->add_around_method_modifier
+#         ('do_apply', $new_do_apply);
+
+# };
+
+};
+
+1;

Added: trunk/Anything/lib/Anything/InterfaceModel/Type.pm
===================================================================
--- trunk/Anything/lib/Anything/InterfaceModel/Type.pm	                        (rev 0)
+++ trunk/Anything/lib/Anything/InterfaceModel/Type.pm	2007-05-21 20:21:44 UTC (rev 3347)
@@ -0,0 +1,18 @@
+package Anything::InterfaceModel::Type;
+
+use Reaction::InterfaceModel::DBIC::ObjectClass;
+
+class Type, which {
+
+  domain_model '_type_store' =>
+    (isa => 'DB::Anything::Type', inflate_result => 1,handles => ['display_name'],
+     reflect => [qw/ID Name Description/]);
+
+  reflect_actions
+    (
+     Create => { attrs =>[qw(Name Description)] },
+     Update => { attrs =>[qw(Name Description)] },
+     Delete => {},
+    );
+};
+1;

Added: trunk/Anything/lib/Anything/Model/Domain.pm
===================================================================
--- trunk/Anything/lib/Anything/Model/Domain.pm	                        (rev 0)
+++ trunk/Anything/lib/Anything/Model/Domain.pm	2007-05-21 20:21:44 UTC (rev 3347)
@@ -0,0 +1,13 @@
+package Anything::Model::Domain;
+
+use base 'Reaction::InterfaceModel::DBIC::ModelBase';
+
+__PACKAGE__->config
+  (
+   im_class => 'Anything::InterfaceModel',
+   db_dsn   => 'dbi:DB2:Books',
+   db_user  => 'missys',
+   db_password => 'missys',
+  );
+
+1;

Added: trunk/Anything/lib/Anything/Types.pm
===================================================================
--- trunk/Anything/lib/Anything/Types.pm	                        (rev 0)
+++ trunk/Anything/lib/Anything/Types.pm	2007-05-21 20:21:44 UTC (rev 3347)
@@ -0,0 +1,15 @@
+package Anything::Types;
+
+use Moose::Util::TypeConstraints;
+use Reaction::Types::Core;
+use Reaction::Types::DateTime;
+
+subtype 'TextField'
+  => as 'Str'
+    ;
+
+subtype 'DateField'
+ => as 'DateTime'
+    ;
+
+1;




More information about the Bast-commits mailing list