--- /dev/null
+package Reaction::UI::ViewPort::Action;
+
+use Reaction::Class;
+
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::Text';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::Array';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::String';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::Number';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::Integer';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::Boolean';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::Password';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::DateTime';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::ChooseOne';
+use aliased 'Reaction::UI::ViewPort::Field::Mutable::ChooseMany';
+
+#use aliased 'Reaction::UI::ViewPort::InterfaceModel::Field::Mutable::File';
+#use aliased 'Reaction::UI::ViewPort::InterfaceModel::Field::Mutable::TimeRange';
+
+class ActionForm is 'Reaction::UI::ViewPort', which {
+ has '+model' => (isa => 'Reaction::InterfaceModel::Action');
+
+ has next_action => (is => 'rw', isa => 'ArrayRef');
+ has on_apply_callback => (is => 'rw', isa => 'CodeRef');
+
+ has ok_label => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has apply_label => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has close_label => (is => 'rw', isa => 'Str', lazy_fail => 1);
+ has close_label_close => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has close_label_cancel => (is => 'rw', isa => 'Str', lazy_build => 1);
+
+ has changed => (is => 'rw', isa => 'Int', reader => 'is_changed', default => sub{0});
+
+ implements BUILD => as{
+ my $self = shift;
+ $self->close_label($self->close_label_close);
+ };
+
+ implements _build_ok_label => as{ 'ok' };
+ implements _build_apply_label_ => as{ 'apply' };
+ implements _build_close_label_close => as{ 'close' };
+ implements _build_close_label_cancel => as{ 'cancel' };
+
+ implements can_apply => as {
+ my ($self) = @_;
+ foreach my $field ( @{ $self->ordered_fields } ) {
+ return 0 if $field->needs_sync;
+ # if e.g. a datetime field has an invalid value that can't be re-assembled
+ # into a datetime object, the action may be in a consistent state but
+ # not synchronized from the fields; in this case, we must not apply
+ }
+ return $self->model->can_apply;
+ };
+
+ implements do_apply => as {
+ shift->model->do_apply;
+ };
+
+ implements ok => as {
+ my $self = shift;
+ $self->close(@_) if $self->apply(@_);
+ };
+
+ implements apply => as {
+ my $self = shift;
+ if ($self->can_apply && (my $result = $self->do_apply)) {
+ $self->changed(0);
+ $self->close_label($self->close_label_close);
+ $self->on_apply_callback->($self => $result) if $self->has_on_apply_callback;
+ return 1;
+ } else {
+ $self->changed(1);
+ $self->close_label($self->close_label_cancel);
+ return 0;
+ }
+ };
+
+ implements close => as {
+ my $self = shift;
+ my ($controller, $name, @args) = @{$self->next_action};
+ $controller->pop_viewport;
+ $controller->$name($self->ctx, @args);
+ };
+
+ implements can_close => as { 1 };
+
+ override accept_events => sub {
+ (($_[0]->has_next_action ? ('ok', 'close') : ()), 'apply', super());
+ }; # can't do a close-type operation if there's nowhere to go afterwards
+
+ after apply_child_events => sub {
+ # interrupt here because fields will have been updated
+ my ($self) = @_;
+ $self->sync_action_from_fields;
+ };
+
+ implements sync_action_from_fields => as {
+ my ($self) = @_;
+ foreach my $field ($self->fields) {
+ $field->sync_to_action; # get the field to populate the $action if possible
+ }
+ $self->action->sync_all;
+ foreach my $field ($self->fields) {
+ $field->sync_from_action; # get errors from $action if applicable
+ }
+ };
+
+
+ implements _build_fields_for_type_Num => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Number, %$args);
+ };
+
+ implements _build_fields_for_type_Int => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
+ };
+
+ implements _build_fields_for_type_Bool => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
+ };
+
+ implements _build_fields_for_type_SimpleStr => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => String, %$args);
+ };
+
+ #implements _build_fields_for_type_File => as {
+ # my ($self, $attr, $args) = @_;
+ # $self->_build_simple_field(attribute => $attr, class => File, %$args);
+ #};
+
+ implements _build_fields_for_type_Str => as {
+ my ($self, $attr, $args) = @_;
+ if ($attr->has_valid_values) { # There's probably a better way to do this
+ $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
+ }
+ $self->_build_simple_field(attribute => $attr, class => Text, %$args);
+ };
+
+ implements _build_fields_for_type_Password => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Password, %$args);
+ };
+
+ implements _build_fields_for_type_DateTime => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
+ };
+
+ implements _build_fields_for_type_Enum => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
+ };
+
+ #this needs to be fixed. somehow. beats the shit our of me. really.
+ #implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
+ implements _build_fields_for_type_DBIx_Class_Row => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
+ };
+
+ implements _build_fields_for_type_ArrayRef => as {
+ my ($self, $attr, $args) = @_;
+ if ($attr->has_valid_values) {
+ $self->_build_simple_field(attribute => $attr, class => ChooseMany, %$args);
+ } else {
+ $self->_build_simple_field
+ (
+ attribute => $attr,
+ class => Array,
+ layout => 'interface_model/field/mutable/array/hidden',
+ %$args);
+ }
+ };
+
+ #implements _build_fields_for_type_DateTime_Spanset => as {
+ # my ($self, $attr, $args) = @_;
+ # $self->_build_simple_field(attribute => $attr, class => TimeRange, %$args);
+ #};
+
+};
+
+ 1;
+
+=head1 NAME
+
+Reaction::UI::ViewPort::InterfaceModel::Action
+
+=head1 SYNOPSIS
+
+ use aliased 'Reaction::UI::ViewPort::ActionForm';
+
+ $self->push_viewport(Action,
+ layout => 'register',
+ model => $action,
+ next_action => [ $self, 'redirect_to', 'accounts', $c->req->captures ],
+ ctx => $c,
+ field_order => [
+ qw / contact_title company_name email address1 address2 address3
+ city country post_code telephone mobile fax/ ],
+ );
+
+=head1 DESCRIPTION
+
+This subclass of viewport is used for rendering a collection of
+L<Reaction::UI::ViewPort::Field> objects for user editing.
+
+=head1 ATTRIBUTES
+
+=head2 model
+
+L<Reaction::InterfaceModel::Action>
+
+=head2 ok_label
+
+Default: 'ok'
+
+=head2 apply_label
+
+Default: 'apply'
+
+=head2 close_label_close
+
+Default: 'close'
+
+=head2 close_label_cancel
+
+This label is only shown when C<changed> is true.
+
+Default: 'cancel'
+
+=head2 fields
+
+=head2 can_apply
+
+=head2 can_close
+
+=head2 changed
+
+Returns true if a field has been edited.
+
+=head2 next_action
+
+=head2 on_apply_callback
+
+CodeRef.
+
+=head1 METHODS
+
+=head2 ok
+
+Calls C<apply>, and then C<close> if successful.
+
+=head2 close
+
+Pop viewport and proceed to C<next_action>.
+
+=head2 apply
+
+Attempt to save changes and update C<changed> attribute if required.
+
+=head1 SEE ALSO
+
+L<Reaction::UI::ViewPort>
+
+L<Reaction::InterfaceModel::Action>
+
+=head1 AUTHORS
+
+See L<Reaction::Class> for authors.
+
+=head1 LICENSE
+
+See L<Reaction::Class> for the license.
+
+=cut
-package Reaction::UI::ViewPort::GridView::Action;
+package Reaction::UI::ViewPort::InterfaceModel::Action::Link;
use Reaction::Class;
-class Action is 'Reaction::UI::ViewPort', which {
+class Link is 'Reaction::UI::ViewPort', which {
has label => (is => 'rw', required => 1);
has uri => ( is => 'rw', lazy_build => 1);
--- /dev/null
+package Reaction::UI::ViewPort::Collection;
+
+use Reaction::Class;
+use Scalar::Util qw/blessed/;
+use aliased 'Reaction::InterfaceModel::Collection' => 'IM_Collection';
+use aliased 'Reaction::UI::ViewPort::Object';
+
+class Collection is 'Reaction::UI::ViewPort', which {
+
+ has members => (is => 'rw', isa => 'ArrayRef', lazy_build => 1);
+
+ has collection => (is => 'ro', isa => IM_Collection, required => 1);
+ has current_collection => (is => 'rw', isa => IM_Collection, lazy_build => 1);
+
+ has member_args => ( is => 'rw', isa => 'HashRef', lazy_build => 1);
+ has member_class => ( is => 'ro', isa => 'Str', lazy_build => 1);
+
+ implements BUILD => as {
+ my ($self, $args) = @_;
+ my $entity_args = delete $args->{Member};
+ $self->member_args( $member_args ) if ref $member_args;
+ };
+
+ implements _build_member_class => as{ Object };
+
+ after clear_current_collection => sub{
+ shift->clear_entities; #clear the entitiesis the current collection changes, duh
+ };
+
+ implements _build_current_collection => as {
+ shift->collection;
+ };
+
+ implements model
+
+ implements _build_members => as {
+ my ($self) = @_;
+ my (@members, $i);
+ my $args = $self->member_args;
+ my $builders = {};
+ my $ctx = $self->ctx;
+ my $loc = join('-', $self->location, 'member');
+ my $class = $self->member_class;
+
+ #replace $i with a real unique identifier so that we don't run a risk of
+ # events being passed down to the wrong viewport. for now i disabled event
+ # passing until i fix this (groditi)
+ for my $obj ( $self->current_collection->members ) {
+ my $type = blessed $obj;
+ my $builder_cache = $builders->{$type} ||= {};
+ my $member = $class->new(
+ ctx => $ctx,
+ object => $obj,
+ location => join('-', $loc, $i++),
+ builder_cache => $builder_cache,
+ %$args
+ );
+ push(@members, $member);
+ }
+ return \@members;
+ };
+
+};
+
+
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Collection::Grid;
+
+use Reaction::Class;
+
+use aliased 'Reaction::InterfaceModel::Collection' => 'IM_Collection';
+use aliased 'Reaction::UI::ViewPort::Collection::Grid::Member';
+
+class Grid is 'Reaction::UI::ViewPort::Collection', which {
+
+ has field_order => ( isa => 'ArrayRef', is => 'ro', lazy_build => 1);
+ has field_labels => ( isa => 'HashRef', is => 'ro', lazy_build => 1);
+
+ has ordered_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
+ has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
+
+ ####################################
+ implements _build_member_class => as { };
+
+ implements _build_field_labels => as {
+ my $self = shift;
+ my %labels;
+ for my $field ( @{$self->field_order}){
+ $labels{$field} = join(' ', map{ ucfirst } split('_', $field));
+ }
+ return \%labels;
+ };
+
+ implements _build_ordered_fields => as {
+ my ($self) = @_;
+ confess("current_collection lacks a value for 'member_type' attribute")
+ unless $self->current_collection->has_member_type;
+ my %excluded = map { $_ => undef } @{ $self->excluded_fields };
+ #treat _$field_name as private and exclude fields with no reader
+ my @names = grep { $_ !~ /^_/ && !exists($exclude{$_})} map { $_->name }
+ grep { defined $_->get_read_method }
+ $self->current_collection->member_type->meta->parameter_attributes;
+ return $self->sort_by_spec($self->field_order, \@names);
+ };
+
+ before _build_members => sub {
+ my ($self) = @_;
+ $self->member_args->{ordered_fields} ||= $self->ordered_fields;
+ };
+
+};
+
+
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Collection::Grid::Member;
+
+use Reaction::Class;
+
+Class Member is 'Reaction::UI::ViewPort::Object', which {
+
+ around _build_fields_for_type_Num => sub {
+ $_[0]->(@_[1..3], { layout => 'value/number', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_Int => sub {
+ $_[0]->(@_[1..3], { layout => 'value/number', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_Bool => sub {
+ $_[0]->(@_[1..3], { layout => 'value/boolean', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_Enum => sub {
+ $_[0]->(@_[1..3], { layout => 'value/string', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_Str => sub {
+ $_[0]->(@_[1..3], { layout => 'value/string', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_SimpleStr => sub {
+ $_[0]->(@_[1..3], { layout => 'value/string', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_Reaction_InterfaceModel_Object => sub {
+ $_[0]->(@_[1..3], { layout => 'value/string', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_DateTime => sub {
+ $_[0]->(@_[1..3], { layout => 'value/date_time', %{ $_[4] } })
+ };
+
+ around _build_fields_for_type_Password => sub { return };
+ around _build_fields_for_type_ArrayRef => sub { return };
+ around _build_fields_for_type_Reaction_InterfaceModel_Collection => sub { return };
+
+};
--- /dev/null
+package Reaction::UI::ViewPort::Collection::Grid::Member::WithActions;
+
+use Reaction::Class;
+
+class WithActions is 'Reaction::UI::ViewPort::Collection::Grid::Member', which {
+
+ does 'Reaction::UI::ViewPort::Role::Actions';
+
+};
+
+1;
-package Reaction::UI::ViewPort::GridView::Role::Order;
+package Reaction::UI::ViewPort::Collection::Role::Order;
use Reaction::Role;
-package Reaction::UI::ViewPort::GridView::Role::Pager;
+package Reaction::UI::ViewPort::Collection::Role::Pager;
use Reaction::Role;
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField;
-
-use Reaction::Class;
-
-class DisplayField is 'Reaction::UI::ViewPort', which {
-
- has name => (
- isa => 'Str', is => 'rw', required => 1
- );
-
- has object => (
- isa => 'Reaction::InterfaceModel::Object',
- is => 'ro', required => 0, predicate => 'has_object',
- );
-
- has attribute => (
- isa => 'Reaction::Meta::InterfaceModel::Object::ParameterAttribute',
- is => 'ro', predicate => 'has_attribute',
- );
-
- has value => (
- is => 'rw', lazy_build => 1, trigger_adopt('value'),
- );
-
- has label => (isa => 'Str', is => 'rw', lazy_build => 1);
-
- implements BUILD => as {
- my ($self) = @_;
- if (!$self->has_attribute != !$self->has_object) {
- confess "Should have both object and attribute or neither"; }
- };
-
- implements _build_label => as {
- my ($self) = @_;
- return join(' ', map { ucfirst } split('_', $self->name));
- };
-
- implements _build_value => as {
- my ($self) = @_;
- if ($self->has_attribute) {
- my $reader = $self->attribute->get_read_method;
- return $self->object->$reader;
- }
- return '';
- };
-
-};
-
-1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::DisplayField
-
-=head1 DESCRIPTION
-
-Base class for displaying non user-editable fields.
-
-=head1 ATTRIBUTES
-
-=head2 name
-
-=head2 object
-
-L<Reaction::InterfaceModel::Object>
-
-=head2 attribute
-
-L<Reaction::Meta::InterfaceModel::Object::ParameterAttribute>
-
-=head2 value
-
-=head2 label
-
-User friendly label, by default is based on the name.
-
-=head1 SEE ALSO
-
-L<Reaction::UI::ViewPort>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField::Boolean;
-
-use Reaction::Class;
-use aliased 'Reaction::UI::ViewPort::DisplayField';
-
-class Boolean, is DisplayField, which {
- has '+value' => (isa => 'Bool');
- #has '+layout' => (default => 'displayfield/value_string');
-
- has value_string => (isa => 'Str', is => 'rw', lazy_build => 1);
-
- has value_string_format =>
- (isa => 'HashRef', is => 'rw', required => 1,
- default => sub { {true => 'Yes', false => 'No'} }
- );
-
- implements _build_value_string => as {
- my $self = shift;
- my $val = $self->value;
- if(!defined $val || $val eq "" || "$val" eq '0'){
- return $self->value_string_format->{false};
- } elsif("$val" eq '1'){
- return $self->value_string_format->{true};
- } else{ #this will hopefully never happen
- confess "Not supporting some type of Bool value";
- }
- };
-
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField::Collection;
-
-use Reaction::Class;
-use Scalar::Util 'blessed';
-
-class Collection is 'Reaction::UI::ViewPort::DisplayField', which {
- has '+value' => (isa => 'ArrayRef');
- #has '+layout' => (default => 'displayfield/list');
-
- has value_names => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
-
- has value_map_method => (
- isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
- );
-
- override _build_value => sub {
- return [super()->members];
- };
-
- implements _build_value_names => as {
- my $self = shift;
- my @all = @{$self->value||[]};
- my $meth = $self->value_map_method;
- my @names = map { blessed $_ ? $_->$meth : $_ } @all;
- return [ sort @names ];
- };
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField::DateTime;
-
-use Reaction::Class;
-use Reaction::Types::DateTime;
-use aliased 'Reaction::UI::ViewPort::DisplayField';
-
-class DateTime is DisplayField, which {
- has '+value' => (isa => 'DateTime');
- #has '+layout' => (default => 'displayfield/value_string');
-
- has value_string => (isa => 'Str', is => 'rw', lazy_build => 1);
-
- has value_string_default_format => (
- isa => 'Str', is => 'rw', required => 1, default => sub { "%F %H:%M:%S" }
- );
-
- implements _build_value_string => as {
- my $self = shift;
- my $value = eval { $self->value };
- return '' unless $self->has_value;
- my $format = $self->value_string_default_format;
- return $value->strftime($format) if $value;
- return '';
- };
-
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField::Number;
-
-use Reaction::Class;
-use aliased 'Reaction::UI::ViewPort::DisplayField';
-
-class Number is DisplayField, which {
- #has '+layout' => (default => 'displayfield/string');
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField::String;
-
-use Reaction::Class;
-use aliased 'Reaction::UI::ViewPort::DisplayField';
-
-class String is DisplayField, which {
- has '+value' => (isa => 'Str');
- #has '+layout' => (default => 'displayfield/string');
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::DisplayField::Text;
-
-use Reaction::Class;
-use aliased 'Reaction::UI::ViewPort::DisplayField';
-
-class Text is DisplayField, which {
- has '+value' => (isa => 'Str');
- #has '+layout' => (default => 'displayfield/text');
-};
-
-1;
package Reaction::UI::ViewPort::Field;
use Reaction::Class;
+use aliased 'Reaction::InterfaceModel::Object';
+use aliased 'Reaction::Meta::InterfaceModel::Object::ParameterAttribute';
class Field is 'Reaction::UI::ViewPort', which {
- has name => (
- isa => 'Str', is => 'rw', required => 1
- );
+ has value => (is => 'rw', lazy_build => 1);
+ has name => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has label => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has value_string => (is => 'rw', isa => 'Str', lazy_build => 1);
- has action => (
- isa => 'Reaction::InterfaceModel::Action',
- is => 'ro', required => 0, predicate => 'has_action',
- );
+ has model => (is => 'ro', isa => Object, required => 1);
+ has attribute => (is => 'ro', isa => ParameterAttribute, required => 1);
- has attribute => (
- isa => 'Reaction::Meta::InterfaceModel::Action::ParameterAttribute',
- is => 'ro', predicate => 'has_attribute',
- );
+ implements adopt_value => as {};
- has value => (
- is => 'rw', lazy_build => 1, trigger_adopt('value'),
- clearer => 'clear_value',
- );
-
- has needs_sync => (
- isa => 'Int', is => 'rw', default => 0
- );
-
- has label => (isa => 'Str', is => 'rw', lazy_build => 1);
-
- has message => (
- isa => 'Str', is => 'rw', required => 1, default => sub { '' }
- );
-
- implements BUILD => as {
- my ($self) = @_;
- if (!$self->has_attribute != !$self->has_action) {
- confess "Should have both action and attribute or neither";
- }
- };
+ implements _build_name => as { shift->attribute->name };
+ implements _build_value_string => as { shift->value };
implements _build_label => as {
- my ($self) = @_;
- my $label = join(' ', map { ucfirst } split('_', $self->name));
- # print STDERR "Field " . $self->name . " has label '$label'\n";
- return $label;
+ join(' ', map { ucfirst } split('_', shift->name));
};
+ #unlazify and move it to build. to deal with array use typeconstraints and coercions
implements _build_value => as {
my ($self) = @_;
- if ($self->has_attribute) {
- my $reader = $self->attribute->get_read_method;
- my $predicate = $self->attribute->predicate;
- if (!$predicate || $self->action->$predicate) {
- return $self->action->$reader;
- }
- }
- return '';
- };
-
- implements adopt_value => as {
- my ($self) = @_;
- $self->needs_sync(1) if $self->has_attribute;
- };
-
- implements sync_to_action => as {
- my ($self) = @_;
- return unless $self->needs_sync && $self->has_attribute && $self->has_value;
- my $attr = $self->attribute;
- if (my $tc = $attr->type_constraint) {
- my $value = $self->value;
- if ($tc->has_coercion) {
- $value = $tc->coercion->coerce($value);
- }
- my $error = $tc->validate($self->value);
- if (defined $error) {
- $self->message($error);
- return;
- }
- }
- my $writer = $attr->get_write_method;
- confess "No writer for attribute" unless defined($writer);
- $self->action->$writer($self->value);
- $self->needs_sync(0);
+ my $reader = $self->attribute->get_read_method;
+ my $predicate = $self->attribute->predicate;
+ #this is bound to blow the fuck if !model->$predicate what to do?
+ return $self->model->$reader if (!$predicate || $self->model->$predicate);
+ return;
};
- implements sync_from_action => as {
- my ($self) = @_;
- return unless !$self->needs_sync && $self->has_attribute;
- $self->message($self->action->error_for($self->attribute)||'');
- };
-
- override accept_events => sub { ('value', super()) };
-
};
1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::Field
-
-=head1 DESCRIPTION
-
-This viewport is the base class for all field types.
-
-=head1 ATTRIBUTES
-
-=head2 name
-
-=head2 action
-
-L<Reaction::InterfaceModel::Action>
-
-=head2 attribute
-
-L<Reaction::Meta::InterfaceModel::Action::ParameterAttribute>
-
-=head2 value
-
-=head2 needs_sync
-
-=head2 label
-
-User friendly label, by default is based on the name.
-
-=head2 message
-
-Optional string relating to the field.
-
-=head1 SEE ALSO
-
-=head2 L<Reaction::UI::ViewPort>
-
-=head2 L<Reaction::UI::ViewPort::DisplayField>
-
-=head2 L<Reaction::UI::ViewPort::Field::Boolean>
-
-=head2 L<Reaction::UI::ViewPort::Field::ChooseMany>
-
-=head2 L<Reaction::UI::ViewPort::Field::ChooseOne>
-
-=head2 L<Reaction::UI::ViewPort::Field::DateTime>
-
-=head2 L<Reaction::UI::ViewPort::Field::File>
-
-=head2 L<Reaction::UI::ViewPort::Field::HiddenArray>
-
-=head2 L<Reaction::UI::ViewPort::Field::Number>
-
-=head2 L<Reaction::UI::ViewPort::Field::Password>
-
-=head2 L<Reaction::UI::ViewPort::Field::String>
-
-=head2 L<Reaction::UI::ViewPort::Field::Text>
-
-=head2 L<Reaction::UI::ViewPort::Field::TimeRange>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
--- /dev/null
+package Reaction::UI::ViewPort::InterfaceModel::Field::File;
+
+use Reaction::Class;
+use Reaction::Types::File;
+
+class File is 'Reaction::UI::ViewPort::InterfaceModel::Field', which {
+
+ has '+value' => (isa => 'File', required => 0);
+
+ override apply_our_events => sub {
+ my ($self, $ctx, $events) = @_;
+ my $value_key = join(':', $self->location, 'value');
+ if (my $upload = $ctx->req->upload($value_key)) {
+ local $events->{$value_key} = $upload;
+ return super();
+ } else {
+ return super();
+ }
+ };
+
+};
+
+1;
+
+=head1 NAME
+
+Reaction::UI::ViewPort::Field::File
+
+=head1 DESCRIPTION
+
+=head1 SEE ALSO
+
+=head2 L<Reaction::UI::ViewPort::Field>
+
+=head1 AUTHORS
+
+See L<Reaction::Class> for authors.
+
+=head1 LICENSE
+
+See L<Reaction::Class> for the license.
+
+=cut
--- /dev/null
+package Reaction::UI::ViewPort::Field::TimeRange;
+
+use Reaction::Class;
+use Reaction::Types::DateTime;
+use DateTime;
+use DateTime::SpanSet;
+use Time::ParseDate ();
+
+class TimeRange is 'Reaction::UI::ViewPort::InterfaceModel::Field', which {
+
+ has '+value' => (isa => 'DateTime::SpanSet');
+
+ #has '+layout' => (default => 'timerange');
+
+ has value_string =>
+ (isa => 'Str', is => 'rw', lazy_fail => 1, trigger_adopt('value_string'));
+
+ has delete_label => (
+ isa => 'Str', is => 'rw', required => 1, default => sub { 'Delete' },
+ );
+
+ has parent => (
+ isa => 'Reaction::UI::ViewPort::TimeRangeCollection',
+ is => 'ro',
+ required => 1,
+ is_weak_ref => 1
+ );
+
+ implements _build_value_string => as {
+ my $self = shift;
+ #return '' unless $self->has_value;
+ #return $self->value_string;
+ };
+
+ implements value_array => as {
+ my $self = shift;
+ return split(',', $self->value_string);
+ };
+
+ implements adopt_value_string => as {
+ my ($self) = @_;
+ my @values = $self->value_array;
+ for my $idx (0 .. 3) { # last value is repeat
+ if (length $values[$idx]) {
+ my ($epoch) = Time::ParseDate::parsedate($values[$idx], UK => 1);
+ $values[$idx] = DateTime->from_epoch( epoch => $epoch );
+ }
+ }
+ $self->value($self->range_to_spanset(@values));
+ };
+
+ implements range_to_spanset => as {
+ my ($self, $time_from, $time_to, $repeat_from, $repeat_to, $pattern) = @_;
+ my $spanset = DateTime::SpanSet->empty_set;
+ if (!$pattern || $pattern eq 'none') {
+ my $span = DateTime::Span->from_datetimes(
+ start => $time_from, end => $time_to
+ );
+ $spanset = $spanset->union( $span );
+ } else {
+ my $duration = $time_to - $time_from;
+ my %args = ( days => $time_from->day + 2,
+ hours => $time_from->hour,
+ minutes => $time_from->minute,
+ seconds => $time_from->second );
+
+ delete $args{'days'} if ($pattern eq 'daily');
+ delete @args{qw/hours days/} if ($pattern eq 'hourly');
+ $args{'days'} = $time_from->day if ($pattern eq 'monthly');
+ my $start_set = DateTime::Event::Recurrence->$pattern( %args );
+ my $iter = $start_set->iterator( start => $repeat_from, end => $repeat_to );
+ while ( my $dt = $iter->next ) {
+ my $endtime = $dt + $duration;
+ my $new_span = DateTime::Span->from_datetimes(
+ start => $dt,
+ end => $endtime
+ );
+ $spanset = $spanset->union( $new_span );
+ }
+ }
+ return $spanset;
+ };
+
+ implements delete => as {
+ my ($self) = @_;
+ $self->parent->remove_range_vp($self);
+ };
+
+ override accept_events => sub { ('value_string', 'delete', super()) };
+
+};
+
+1;
+
+=head1 NAME
+
+Reaction::UI::ViewPort::Field::TimeRange
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 value
+
+ Accessor for a L<DateTime::SpanSet> object.
+
+=head2 value_string
+
+ Returns: Encoded range string representing the value.
+
+=head2 value_array
+
+ Returns: Arrayref of the elements of C<value_string>.
+
+=head2 parent
+
+ L<Reaction::UI::ViewPort::TimeRangeCollection> object.
+
+=head2 range_to_spanset
+
+ Arguments: $self, $time_from, $time_to, $repeat_from, $repeat_to, $pattern
+ where $time_from, $time_to, $repeat_from, $repeat_to are L<DateTime>
+ objects, and $pattern is a L<DateTime::Event::Recurrence> method name
+
+ Returns: $spanset
+
+=head2 delete
+
+ Removes TimeRange from C<parent> collection.
+
+=head2 delete_label
+
+ Label for the delete option. Default: 'Delete'.
+
+=head1 SEE ALSO
+
+=head2 L<Reaction::UI::ViewPort::Field>
+
+=head2 L<Reaction::UI::ViewPort::TimeRangeCollection>
+
+=head1 AUTHORS
+
+See L<Reaction::Class> for authors.
+
+=head1 LICENSE
+
+See L<Reaction::Class> for the license.
+
+=cut
-package Reaction::UI::ViewPort::DisplayField::List;
+package Reaction::UI::ViewPort::Field::Array;
use Reaction::Class;
use Scalar::Util 'blessed';
-use aliased 'Reaction::UI::ViewPort::DisplayField';
+use aliased 'Reaction::UI::ViewPort::Field';
-class List is DisplayField, which {
+class Array is Field, which {
has '+value' => (isa => 'ArrayRef');
- #has '+layout' => (default => 'displayfield/list');
has value_names => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
-
has value_map_method => (
isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
);
- override _build_value => sub {
- return super() || [];
- };
-
implements _build_value_names => as {
my $self = shift;
- my @all = @{$self->value||[]};
+ my @all = @{ $self->value || []};
my $meth = $self->value_map_method;
my @names = map { blessed($_) ? $_->$meth : $_ } @all;
return [ sort @names ];
package Reaction::UI::ViewPort::Field::Boolean;
use Reaction::Class;
+use aliased 'Reaction::UI::ViewPort::Field';
-class Boolean is 'Reaction::UI::ViewPort::Field', which {
-
+class Boolean, is Field, which {
has '+value' => (isa => 'Bool');
- #has '+layout' => (default => 'checkbox');
-
};
1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::Field::Boolean
-
-=head1 DESCRIPTION
-
-=head1 SEE ALSO
-
-=head2 L<Reaction::UI::ViewPort::Field>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
--- /dev/null
+package Reaction::UI::ViewPort::Field::Collection;
+
+use Reaction::Class;
+use Scalar::Util 'blessed';
+use aliased 'Reaction::UI::ViewPort::Field::Array';
+
+class Collection is Array, which {
+
+ #XXX
+ override _build_value => sub {
+ return [super()->members];
+ };
+
+};
+
+1;
use Reaction::Class;
use Reaction::Types::DateTime;
-use Time::ParseDate ();
-
-class DateTime is 'Reaction::UI::ViewPort::Field', which {
+use aliased 'Reaction::UI::ViewPort::Field';
+class DateTime is Field, which {
has '+value' => (isa => 'DateTime');
- #has '+layout' => (default => 'dt_textfield');
-
- has value_string => (
- isa => 'Str', is => 'rw', lazy_build => 1,
- trigger_adopt('value_string')
- );
-
has value_string_default_format => (
isa => 'Str', is => 'rw', required => 1, default => sub { "%F %H:%M:%S" }
);
implements _build_value_string => as {
my $self = shift;
-
# XXX
#<mst> aha, I know why the fucker's lazy
#<mst> it's because if value's calculated
return '';
};
- implements adopt_value_string => as {
- my ($self) = @_;
- my $value = $self->value_string;
- my ($epoch) = Time::ParseDate::parsedate($value, UK => 1);
- if (defined $epoch) {
- my $dt = 'DateTime'->from_epoch( epoch => $epoch );
- $self->value($dt);
- } else {
- $self->message("Could not parse date or time");
- $self->clear_value;
- $self->needs_sync(1);
- }
- };
-
- override accept_events => sub {
- ('value_string', super());
- };
-
};
1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::Field::DateTime
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=head2 value_string
-
-Accessor for the string representation of the DateTime object.
-
-=head2 value_string_default_format
-
-By default it is set to "%F %H:%M:%S".
-
-=head1 SEE ALSO
-
-=head2 L<DateTime>
-
-=head2 L<Reaction::UI::ViewPort::Field>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
--- /dev/null
+package Reaction::UI::ViewPort::Field::Integer;
+
+use Reaction::Class;
+use aliased 'Reaction::UI::ViewPort::Field';
+
+class Integer is Field, which {
+ has '+value' => (isa => 'Int');
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::Array;
+
+use Reaction::Class;
+
+class Array is 'Reaction::UI::ViewPort::Field::Array', which {
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+
+ around value => sub {
+ my $orig = shift;
+ my $self = shift;
+ return $orig->($self) unless @_;
+ my $value = defined $_[0] ? $_[0] || [];
+ $orig->($self, (ref $value eq 'ARRAY' ? $value : [ $value ]));
+ $self->sync_to_action;
+ };
+};
+
+1;
+
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::Boolean;
+
+use Reaction::Class;
+
+class Boolean is 'Reaction::UI::ViewPort::Field::Boolean', which{
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::ChooseMany;
+
+use Reaction::Class;
+
+my $listify = sub{
+ return [] unless defined $_[0];
+ return ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]];
+};
+
+class ChooseMany is 'Reaction::UI::ViewPort::Field', which {
+
+ has '+value' => (isa => 'ArrayRef');
+
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+ does 'Reaction::UI::ViewPort::Field::Role::Choices';
+
+ around value => sub {
+ my $orig = shift;
+ my $self = shift;
+ return $orig->($self) unless @_;
+ my $value = $listify->(shift);
+ $_ = $self->str_to_ident($_) for @$value;
+ my $checked = $self->attribute->check_valid_value($self->action, $value);
+ # i.e. fail if any of the values fail
+ confess "Not a valid set of values"
+ if (@$checked < @$value || grep { !defined($_) } @$checked);
+ $orig->($self, $checked);
+ };
+
+ #XXX go away!
+ override _build_value => sub {
+ return super() || [];
+ };
+
+ implements is_current_value => as {
+ my ($self, $check_value) = @_;
+ my @our_values = @{$self->value||[]};
+ $check_value = $self->obj_to_str($check_value) if ref($check_value);
+ return grep { $self->obj_to_str($_) eq $check_value } @our_values;
+ };
+
+ implements current_value_choices => as {
+ my $self = shift;
+ my @all = grep { $self->is_current_value($_->{value}) } @{$self->value_choices};
+ return [ @all ];
+ };
+
+ implements available_value_choices => as {
+ my $self = shift;
+ my @all = grep { !$self->is_current_value($_->{value}) } @{$self->value_choices};
+ return [ @all ];
+ };
+
+ around handle_events => sub {
+ my $orig = shift;
+ my ($self, $events) = @_;
+ my $ev_value = $listify->($events->{value});
+ if (delete $events->{add_all_values}) {
+ $events->{value} = [map {$self->obj_to_str($_)} @{$self->valid_values}];
+ } elsif (exists $events->{add_values} && delete $events->{do_add_values}) {
+ my $add = $listify->(delete $events->{add_values});
+ $events->{value} = [ @{$ev_value}, @$add ];
+ } elsif (delete $events->{remove_all_values}) {
+ $events->{value} = [];
+ }elsif (exists $events->{remove_values} && delete $events->{do_remove_values}) {
+ my $remove = $listify->(delete $events->{remove_values});
+ my %r = map { ($_ => 1) } @$remove;
+ $events->{value} = [ grep { !$r{$_} } @{$ev_value} ];
+ }
+ return $orig->(@_);
+ };
+
+};
+
+1;
+
+=head1 NAME
+
+Reaction::UI::ViewPort::Field::ChooseMany
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 is_current_value
+
+=head2 current_values
+
+=head2 available_values
+
+=head2 available_value_names
+
+=head1 SEE ALSO
+
+=head2 L<Reaction::UI::ViewPort::Field>
+
+=head1 AUTHORS
+
+See L<Reaction::Class> for authors.
+
+=head1 LICENSE
+
+See L<Reaction::Class> for the license.
+
+=cut
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::ChooseOne;
+
+use Reaction::Class;
+
+class ChooseOne is 'Reaction::UI::ViewPort::Field', which {
+
+ does 'Reaction::UI::ViewPort::Object::Field::Role::Mutable';
+ does 'Reaction::UI::ViewPort::Object::Field::Role::Choices';
+
+ around value => sub {
+ my $orig = shift;
+ my $self = shift;
+ return $orig->($self) unless @_;
+ my $value = shift;
+ if (defined $value) {
+ $value = $self->str_to_ident($value) if (!ref $value);
+ my $checked = $self->attribute->check_valid_value($self->action, $value);
+ confess "${value} is not a valid value" unless defined($checked);
+ $value = $checked;
+ }
+ $orig->($self, $value);
+ };
+
+ implements is_current_value => as {
+ my ($self, $check_value) = @_;
+ my $our_value = $self->value;
+ return unless ref($our_value);
+ $check_value = $self->obj_to_str($check_value) if ref($check_value);
+ return $self->obj_to_str($our_value) eq $check_value;
+ };
+
+
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::DateTime;
+
+use Reaction::Class;
+use Time::ParseDate;
+use DateTime;
+
+class 'Reaction::UI::ViewPort::Field::Mutable::DateTime'
+ is 'Reaction::UI::ViewPort::Field::DateTime', which {
+
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+
+ has value_string =>
+ ( is => 'rw', isa => 'Str', lazy_build => 1, trigger_adopt('value_string') );
+
+ implements adopt_value_string => as {
+ my ($self) = @_;
+ my $value = $self->value_string;
+ my ($epoch) = Time::ParseDate::parsedate($value);
+ if (defined $epoch) {
+ my $dt = 'DateTime'->from_epoch( epoch => $epoch );
+ $self->value($dt);
+ } else {
+ $self->message("Could not parse date or time");
+ $self->clear_value;
+ $self->needs_sync(1);
+ }
+ };
+
+ override accept_events => sub {
+ ('value_string', super());
+ };
+
+};
+
+1;
+
+
+=head1 NAME
+
+Reaction::UI::ViewPort::Field::DateTime
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 value_string
+
+Accessor for the string representation of the DateTime object.
+
+=head2 value_string_default_format
+
+By default it is set to "%F %H:%M:%S".
+
+=head1 SEE ALSO
+
+=head2 L<DateTime>
+
+=head2 L<Reaction::UI::ViewPort::Field>
+
+=head1 AUTHORS
+
+See L<Reaction::Class> for authors.
+
+=head1 LICENSE
+
+See L<Reaction::Class> for the license.
+
+=cut
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::Integer;
+
+use Reaction::Class;
+
+class Integer is 'Reaction::UI::ViewPort::Field::Integer', which {
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::Number;
+
+use Reaction::Class;
+
+class Number 'Reaction::UI::ViewPort::Field::Number', which {
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::Password;
+
+use Reaction::Class;
+
+class Password is 'Reaction::UI::ViewPort::Field::String', which {
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::String;
+
+use Reaction::Class;
+
+class String is 'Reaction::UI::ViewPort::Field::String', which {
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Mutable::Text;
+
+use Reaction::Class;
+
+class Text is 'Reaction::UI::ViewPort::Field::Text', which {
+ does 'Reaction::UI::ViewPort::Field::Role::Mutable';
+};
+
+1;
package Reaction::UI::ViewPort::Field::Number;
use Reaction::Class;
+use aliased 'Reaction::UI::ViewPort::Field';
-class Number is 'Reaction::UI::ViewPort::Field', which {
-
- #has '+layout' => (default => 'textfield');
-
+class Number is Field, which {
+ has '+value' => (isa => 'Num');
};
1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::Field::Number
-
-=head1 DESCRIPTION
-
-=head1 SEE ALSO
-
-=head2 L<Reaction::UI::ViewPort::Field>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
-package Reaction::UI::ViewPort::DisplayField::RelatedObject;
+package Reaction::UI::ViewPort::Field::RelatedObject;
use Reaction::Class;
use Scalar::Util 'blessed';
-use aliased 'Reaction::UI::ViewPort::DisplayField';
-class RelatedObject is DisplayField, which {
-
- #has '+layout' => (default => 'displayfield/value_string');
-
- has value_string => (isa => 'Str', is => 'ro', lazy_build => 1);
+class RelatedObject is 'Reaction::UI::ViewPort::Field', which {
has value_map_method => (
isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
--- /dev/null
+package Reaction::UI::ViewPort::Field::Role::Choices;
+
+use Reaction::Class;
+use URI;
+use Scalar::Util 'blessed';
+
+role Choices, which {
+
+ has valid_values => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
+ has value_choices => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
+ has value_map_method => (
+ isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
+ );
+
+ implements str_to_ident => as {
+ my ($self, $str) = @_;
+ my $u = URI->new('','http');
+ $u->query($str);
+ return { $u->query_form };
+ };
+
+ implements obj_to_str => as {
+ my ($self, $obj) = @_;
+ return $obj unless ref($obj);
+ confess "${obj} not an object" unless blessed($obj);
+ my $ident = $obj->ident_condition; #XXX DBIC ism that needs to go away
+ my $u = URI->new('', 'http');
+ $u->query_form(%$ident);
+ return $u->query;
+ };
+
+ implements obj_to_name => as {
+ my ($self, $obj) = @_;
+ return $obj unless ref($obj);
+ confess "${obj} not an object" unless blessed($obj);
+ my $meth = $self->value_map_method;
+ return $obj->$meth;
+ };
+
+ implements _build_valid_values => as {
+ my $self = shift;
+ return [ $self->attribute->all_valid_values($self->action) ];
+ };
+
+ implements _build_value_choices => sub{
+ my $self = shift;
+ my @pairs = map{{value => $self->obj_to_str($_), name => $self->obj_to_name($_)}}
+ @{ $self->valid_values };
+ return [ sort { $a->{name} cmp $b->{name} } @pairs ];
+ };
+
+};
+
+1;
--- /dev/null
+package Reaction::UI::ViewPort::Field::Role::Mutable;
+
+use aliased 'Reaction::InterfaceModel::Action';
+use aliased 'Reaction::Meta::InterfaceModel::Action::ParameterAttribute';
+
+role Mutable, which {
+ has model => (is => 'ro', isa => Action, required => 1);
+ has attribute => (is => 'ro', isa => ParameterAttribute, required => 1);
+
+ has value => (is => 'rw', lazy_build => 1, trigger_adopt('value'));
+ has needs_sync => (is => 'rw', isa => 'Int', default => 0);
+ has message => (is => 'rw', isa => 'Str');
+
+ implements adopt_value => as {
+ my ($self) = @_;
+ $self->needs_sync(1); # if $self->has_attribute;
+ };
+
+ implements sync_to_action => as {
+ my ($self) = @_;
+ return unless $self->needs_sync && $self->has_value;
+ my $attr = $self->attribute;
+ if (my $tc = $attr->type_constraint) {
+ my $value = $self->value;
+ $value = $tc->coercion->coerce($value) if ($tc->has_coercion);
+ my $error = $tc->validate($self->value); # should we be checking against $value?
+ if (defined $error) {
+ $self->message($error);
+ return;
+ }
+ }
+ my $writer = $attr->get_write_method;
+ confess "No writer for attribute" unless defined($writer);
+ $self->action->$writer($self->value); #should we be passing $value ?
+ $self->needs_sync(0);
+ };
+
+ implements sync_from_action => as {
+ my ($self) = @_;
+ return unless !$self->needs_sync; # && $self->has_attribute;
+ $self->message($self->action->error_for($self->attribute) || '');
+ };
+
+ around accept_events => sub { ('value', shift->(@_)) };
+
+};
package Reaction::UI::ViewPort::Field::String;
use Reaction::Class;
+use aliased 'Reaction::UI::ViewPort::Field';
-class String is 'Reaction::UI::ViewPort::Field', which {
-
- has '+value' => (isa => 'Str'); # accept over 255 chars in case, upstream
- # constraint from model should catch it
-
- #has '+layout' => (default => 'textfield');
-
+class String is Field, which {
+ has '+value' => (isa => 'Str');
};
1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::Field::String
-
-=head1 DESCRIPTION
-
-=head1 SEE ALSO
-
-=head2 L<Reaction::UI::ViewPort::Field>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
package Reaction::UI::ViewPort::Field::Text;
use Reaction::Class;
+use aliased 'Reaction::UI::ViewPort::Field';
-class Text is 'Reaction::UI::ViewPort::Field', which {
-
+class Text is Field, which {
has '+value' => (isa => 'Str');
- #has '+layout' => (default => 'textarea');
-
};
1;
-
-=head1 NAME
-
-Reaction::UI::ViewPort::Field::Text
-
-=head1 DESCRIPTION
-
-=head1 SEE ALSO
-
-=head2 L<Reaction::UI::ViewPort::Field>
-
-=head1 AUTHORS
-
-See L<Reaction::Class> for authors.
-
-=head1 LICENSE
-
-See L<Reaction::Class> for the license.
-
-=cut
+++ /dev/null
-package Reaction::UI::ViewPort::GridView;
-
-use Reaction::Class;
-
-use aliased 'Reaction::InterfaceModel::Collection' => 'IM_Collection';
-use aliased 'Reaction::UI::ViewPort::GridView::Entity';
-
-class GridView is 'Reaction::UI::ViewPort', which {
-
- has exclude_fields => ( isa => 'ArrayRef', is => 'ro' );
- has field_order => ( isa => 'ArrayRef', is => 'ro', lazy_build => 1);
- has field_labels => ( isa => 'HashRef', is => 'ro', lazy_build => 1);
-
-
- has entities => ( isa => 'ArrayRef', is => 'rw', lazy_build => 1);
-
- has collection => (isa => IM_Collection, is => 'ro', required => 1);
- has current_collection => (isa => IM_Collection, is => 'rw', lazy_build => 1);
-
- has entity_class => ( isa => 'Str', is => 'rw', lazy_build => 1);
- has entity_args => ( is => 'rw' );
-
- implements BUILD => as {
- my ($self, $args) = @_;
- my $entity_args = delete $args->{Entity};
- $self->entity_args( $entity_args ) if ref $entity_args;
- };
-
- after clear_current_collection => sub{
- shift->clear_entities; #clear the entitiesis the current collection changes, duh
- };
-
- implements _build_entity_class => as { Entity };
-
- implements _build_field_order => as {
- my ($self) = @_;
- my %excluded = map { $_ => undef }
- @{ $self->has_exclude_fields ? $self->exclude_fields : [] };
- #XXX this abuse of '_im_class' needs to be fixed ASAP
- my $object_class = $self->collection->_im_class;
- my @fields = $object_class->meta->parameter_attributes;
- #obviously only get fields with readers.
- @fields = grep { $_->get_read_method } @fields;
- #eliminate excluded fields & treat names that start with an underscore as private
- @fields = grep {$_->name !~ /^_/ && !exists $excluded{$_->name} } @fields;
-
- #eliminate fields marked as collections, or fields that are arrayrefs
- @fields = grep {
- !($_->has_type_constraint &&
- ($_->type_constraint->is_a_type_of('ArrayRef') ||
- eval {$_->type_constraint->name->isa('Reaction::InterfaceModel::Collection')} ||
- eval { $_->_isa_metadata->isa('Reaction::InterfaceModel::Collection') }
- )
- ) } @fields;
-
- #order the columns all nice and pretty, and only get fields with readers, duh
- my $ordered = $self->sort_by_spec
- ( $self->column_order, [ map { (($_->name) || ()) } @fields] );
-
- return $ordered;
- };
-
- implements _build_current_collection => as {
- shift->collection;
- };
-
- implements _build_field_labels => as {
- my $self = shift;
- my %labels;
- for my $field ( @{$self->field_order}){
- $labels{$field} = join(' ', map{ ucfirst } split('_', $field));
- }
- return \%labels;
- };
-
- implements _build_entities => as {
- my ($self) = @_;
- my (@entities, $i);
- my $args = $self->has_entity_args ? $self->entity_args : {};
- my $builders = {};
- my $ctx = $self->ctx;
- my $loc = $self->location;
- my $order = $self->field_order;
- my $class = $self->entity_class;
- for my $obj ( $self->current_collection->members ) {
- my $row = $class->new(
- ctx => $ctx,
- object => $obj,
- location => join('-', $loc, 'row', $i++),
- field_order => $order,
- builder_cache => $builders,
- ref $args ? %$args : ()
- );
- push(@entities, $row);
- }
- return \@entities;
- };
-
-};
-
-
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::GridView::Entity;
-
-use Reaction::Class;
-use Catalyst::Utils;
-use aliased 'Reaction::InterfaceModel::Object';
-use aliased 'Reaction::UI::ViewPort::DisplayField::Text';
-use aliased 'Reaction::UI::ViewPort::DisplayField::Number';
-use aliased 'Reaction::UI::ViewPort::DisplayField::Boolean';
-use aliased 'Reaction::UI::ViewPort::DisplayField::String';
-use aliased 'Reaction::UI::ViewPort::DisplayField::DateTime';
-use aliased 'Reaction::UI::ViewPort::DisplayField::RelatedObject';
-
-
-class Entity is 'Reaction::UI::ViewPort', which {
-
- has object => (isa => Object, is => 'ro', required => 1);
- has field_order => (isa => 'ArrayRef', is => 'ro', required => 1);
-
- has fields => (isa => 'ArrayRef', is => 'rw', lazy_build => 1);
- has builder_cache => (isa => 'HashRef', is => 'ro');
- has field_args => (isa => 'rw');
-
- implements BUILD => as {
- my ($self, $args) = @_;
- my $field_args = delete $args->{Field};
- $self->field_args( {Field => $field_args} ) if ref $field_args;
- };
-
- implements _build_fields => as {
- my ($self) = @_;
- my $obj = $self->object;
- my $args = $self->has_field_args ? $self->field_args : {};
- my $builders = $self->has_builder_cache ? $self->builder_cache : {};
- my @cells;
- for my $field (@{ $self->field_order }) {
- my $attr = $obj->meta->find_attribute_by_name($field);
- my $build_meth = $builders->{$field} ||= $self->get_builder_for($attr);
- my $loc = join('-', $self->location, 'field', $attr->name);
- my $vp_args = {Field => { $attr->name => {location => $loc} } };
- my $merged = Catalyst::Utils::merge_hashes($args, $vp_args);
- my $cell = $self->$build_meth($obj, $attr, $merged);
- #XXX add a blank VP if !$cell here to mantain grid integrity
- push(@cells, $cell) if $cell;
- }
- return \@cells;
- };
-
- implements get_builder_for => as {
- my ($self, $attr) = @_;
- my $attr_name = $attr->name;
- my $builder = "_build_fields_for_name_${attr_name}";
- return $builder if $self->can($builder);
- if ($attr->has_type_constraint) {
- my $constraint = $attr->type_constraint;
- my $base_name = $constraint->name;
- my $tried_isa = 0;
- CONSTRAINT: while (defined($constraint)) {
- my $name = $constraint->name;
- $name = $attr->_isa_metadata if($name eq '__ANON__');
- if (eval { $name->can('meta') } && !$tried_isa++) {
- foreach my $class ($name->meta->class_precedence_list) {
- my $mangled_name = $class;
- $mangled_name =~ s/:+/_/g;
- my $builder = "_build_fields_for_type_${mangled_name}";
- return $builder if $self->can($builder);
- }
- }
- if (defined($name)) {
- unless (defined($base_name)) {
- $base_name = "(anon subtype of ${name})";
- }
- my $mangled_name = $name;
- $mangled_name =~ s/:+/_/g;
- my $builder = "_build_fields_for_type_${mangled_name}";
- return $builder if $self->can($builder);
- }
- $constraint = $constraint->parent;
- }
- if (!defined($constraint)) {
- confess "Can't build field ${attr_name} of type ${base_name} without $builder method or _build_fields_for_type_<type> method for type or any supertype";
- }
- } else {
- confess "Can't build field ${attr} without $builder method or type constraint";
- }
- };
-
-
- implements _build_simple_field => as {
- my ($self, $class, $obj, $attr, $args) = @_;
- my $attr_name = $attr->name;
- my %extra;
- if (my $config = $args->{Field}{$attr_name}) {
- %extra = %$config;
- }
-
- return $class->new(
- object => $obj,
- attribute => $attr,
- name => $attr->name,
- ctx => $self->ctx,
- %extra
- );
- };
-
- implements _build_fields_for_type_Num => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/number'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(Number, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_Int => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/number'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(Number, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_Bool => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/boolean'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(Boolean, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_Password => as { return };
-
- implements _build_fields_for_type_Str => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/string'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(String, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_SimpleStr => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/string'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(String, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_DateTime => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/date_time'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(DateTime, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_Enum => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/string'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(String, $obj, $attr, $args);
- };
-
- implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
- my ($self, $obj, $attr, $args) = @_;
- $args->{Field}{$attr->name}{layout} = 'value/string'
- unless( exists $args->{Field}{$attr->name} &&
- exists $args->{Field}{$attr->name}{layout} &&
- defined $args->{Field}{$attr->name}{layout}
- );
- return $self->_build_simple_field(RelatedObject, $obj, $attr, $args);
- };
-
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::GridView::Entity::WithActions;
-
-use Reaction::Class;
-
-class WithActions is 'Reaction::UI::ViewPort::GridView::Entity', which {
-
- does 'Reaction::UI::ViewPort::GridView::Role::Entity::Actions';
-
-};
-
-1;
+++ /dev/null
-package Reaction::UI::ViewPort::GridView::Role::Entity::Actions;
-
-use strict;
-use warnings;
-
-use Reaction::Role;
-use Reaction::UI::ViewPort::GridView::Action;
-
-role Actions, which {
-
- has actions => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
- has action_prototypes => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
- implements _build_action_prototypes => as { [] };
-
- implements _build_actions => as {
- my ($self) = @_;
- my (@act, $i);
- my $ctx = $self->ctx;
- my $obj = $self->object;
- my $loc = $self->location;
- foreach my $proto (@{ $self->action_prototypes }) {
- my $action = Reaction::UI::ViewPort::GridView::Action->new
- (
- ctx => $ctx,
- target => $obj,
- location => join('-', $loc, 'action', $i++),
- %$proto,
- );
- push(@act, $action);
- }
- return \@act;
- };
-
-};
-
-1;
does 'Reaction::UI::ViewPort::GridView::Role::Pager';
does 'Reaction::UI::ViewPort::GridView::Role::Actions';
-
#If I decide that object actions and collection actions should be
#lumped together i oculd move these into the collection action role
#ooor we could create a third role that does this, but gah, no?
--- /dev/null
+package Reaction::UI::ViewPort::Object;
+
+use Reaction::Class;
+
+use aliased 'Reaction::UI::ViewPort::Field::Text';
+use aliased 'Reaction::UI::ViewPort::Field::Number';
+use aliased 'Reaction::UI::ViewPort::Field::Integer';
+use aliased 'Reaction::UI::ViewPort::Field::Boolean';
+use aliased 'Reaction::UI::ViewPort::Field::String';
+use aliased 'Reaction::UI::ViewPort::Field::DateTime';
+use aliased 'Reaction::UI::ViewPort::Field::RelatedObject';
+use aliased 'Reaction::UI::ViewPort::Field::List';
+use aliased 'Reaction::UI::ViewPort::Field::Collection';
+
+use aliased 'Reaction::InterfaceModel::Object' => 'IM_Object';
+
+class Object is 'Reaction::UI::ViewPort', which {
+
+ #everything is read only right now. Later I can make somethings read-write
+ #but first I need to figure out what depends on what so we can have decent triggers
+ has model => (is => 'ro', isa => IM_Object, required => 1);
+ has fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
+
+ has field_args => (is => 'ro');
+ has field_order => (is => 'ro', isa => 'ArrayRef');
+
+ has builder_cache => (is => 'ro', isa => 'HashRef', lazy_build => 1);
+ has ordered_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
+ has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
+
+ implements BUILD => as {
+ my ($self, $args) = @_;
+ my $field_args = delete $args->{Field};
+ $self->field_args( $field_args ) if ref $field_args;
+ };
+
+ implements _build_excluded_fields => as { [] };
+ implements _build_builder_cache => as { {} };
+
+ implements _build_fields => as {
+ my ($self) = @_;
+ my $obj = $self->model;
+ my $args = $self->has_field_args ? $self->field_args : {};
+ my @fields;
+ for my $field_name (@{ $self->field_order }) {
+ my $attr = $obj->meta->find_attribute_by_name($field_name);
+ my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr);
+ my $field = $self->$meth($obj, $attr, ($args->{$field_name} || {}));
+ push(@fields, $field) if $field;
+ }
+ return \@field;
+ };
+
+ implements _build_ordered_fields => as {
+ my ($self) = @_;
+ my %excluded = map { $_ => undef } @{ $self->excluded_fields };
+ #treat _$field_name as private and exclude fields with no reader
+ my @names = grep { $_ !~ /^_/ && !exists($exclude{$_})} map { $_->name }
+ grep { defined $_->get_read_method } $self->model->meta->parameter_attributes;
+ return $self->sort_by_spec($self->field_order, \@names);
+ };
+
+ override child_event_sinks => sub {
+ return ( shift->fields, super());
+ };
+
+ #candidate for shared role!
+ implements get_builder_for => as {
+ my ($self, $attr) = @_;
+ my $attr_name = $attr->name;
+ my $builder = "_build_fields_for_name_${attr_name}";
+ return $builder if $self->can($builder);
+ if ($attr->has_type_constraint) {
+ my $constraint = $attr->type_constraint;
+ my $base_name = $constraint->name;
+ my $tried_isa = 0;
+ CONSTRAINT: while (defined($constraint)) {
+ my $name = $constraint->name;
+ $name = $attr->_isa_metadata if($name eq '__ANON__');
+ if (eval { $name->can('meta') } && !$tried_isa++) {
+ foreach my $class ($name->meta->class_precedence_list) {
+ my $mangled_name = $class;
+ $mangled_name =~ s/:+/_/g;
+ my $builder = "_build_fields_for_type_${mangled_name}";
+ return $builder if $self->can($builder);
+ }
+ }
+ if (defined($name)) {
+ unless (defined($base_name)) {
+ $base_name = "(anon subtype of ${name})";
+ }
+ my $mangled_name = $name;
+ $mangled_name =~ s/:+/_/g;
+ my $builder = "_build_fields_for_type_${mangled_name}";
+ return $builder if $self->can($builder);
+ }
+ $constraint = $constraint->parent;
+ }
+ if (!defined($constraint)) {
+ confess "Can't build field ${attr_name} of type ${base_name} without $builder method or _build_fields_for_type_<type> method for type or any supertype";
+ }
+ } else {
+ confess "Can't build field ${attr} without $builder method or type constraint";
+ }
+ };
+
+ implements _build_simple_field => as {
+ my ($self, %args) = @_;
+ my $class = delete $args{class};
+ confess("Can not build simple field without a viewport class")
+ unless $class;
+ confess("Can not build simple field without attribute")
+ unless defined $args{attribute};
+
+ my $field_name = $args{attribute}->name;
+ return $class->new(
+ ctx => $self->ctx,
+ model => $self->model,
+ location => join('-', $self->location, 'field', $field_name),
+ %args
+ );
+ };
+
+ implements _build_fields_for_type_Num => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Number, %$args);
+ };
+
+ implements _build_fields_for_type_Int => as {
+ my ($self, $attr, $args) = @_;
+ #XXX
+ $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
+ };
+
+ implements _build_fields_for_type_Bool => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
+ };
+
+ #XXX
+ implements _build_fields_for_type_Password => as { return };
+
+ implements _build_fields_for_type_Str => as {
+ my ($self, $attr, $args) = @_;
+ #XXX
+ $self->_build_simple_field(attribute => $attr, class => String, %$args);
+ };
+
+ implements _build_fields_for_type_SimpleStr => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => String, %$args);
+ };
+
+ implements _build_fields_for_type_DateTime => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
+ };
+
+ implements _build_fields_for_type_Enum => as {
+ my ($self, $attr, $args) = @_;
+ #XXX
+ $self->_build_simple_field(attribute => $attr, class => String, %$args);
+ };
+
+ implements _build_fields_for_type_ArrayRef => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => List, %$args);
+ };
+
+ implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
+ my ($self, $attr, $args) = @_;
+ #XXX
+ $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args);
+ };
+
+ implements _build_fields_for_type_Reaction_InterfaceModel_Collection => as {
+ my ($self, $attr, $args) = @_;
+ $self->_build_simple_field(attribute => $attr, class => Collection, %$args);
+ };
+
+};
+
+1;
+++ /dev/null
-package Reaction::UI::ViewPort::ObjectView;
-
-use Reaction::Class;
-
-use aliased 'Reaction::UI::ViewPort::DisplayField::Text';
-use aliased 'Reaction::UI::ViewPort::DisplayField::Number';
-use aliased 'Reaction::UI::ViewPort::DisplayField::Boolean';
-use aliased 'Reaction::UI::ViewPort::DisplayField::String';
-use aliased 'Reaction::UI::ViewPort::DisplayField::DateTime';
-use aliased 'Reaction::UI::ViewPort::DisplayField::RelatedObject';
-use aliased 'Reaction::UI::ViewPort::DisplayField::List';
-use aliased 'Reaction::UI::ViewPort::DisplayField::Collection';
-use aliased 'Reaction::InterfaceModel::Object';
-
-
-class ObjectView is 'Reaction::UI::ViewPort', which {
- has object => (isa => Object, is => 'ro', required => 1);
- has ordered_fields => (is => 'rw', isa => 'ArrayRef', lazy_build => 1);
-
- has _field_map => (
- isa => 'HashRef', is => 'rw', init_arg => 'fields', lazy_build => 1,
- );
-
- has exclude_fields =>
- ( is => 'rw', isa => 'ArrayRef', required => 1, default => sub{ [] } );
-
-
-
- implements fields => as { shift->_field_map };
-
- implements BUILD => as {
- my ($self, $args) = @_;
- unless ($self->_has_field_map) {
- my @field_map;
- my $object = $self->object;
- my %excluded = map{$_ => 1} @{$self->exclude_fields};
- for my $attr (grep { !$excluded{$_->name} } $object->parameter_attributes) {
- push(@field_map, $self->_build_fields_for($attr => $args));
- }
-
- my %field_map = @field_map;
- $self->_field_map( \%field_map );
- }
- };
-
- implements _build_fields_for => as {
- my ($self, $attr, $args) = @_;
- my $attr_name = $attr->name;
- my $builder = "_build_fields_for_name_${attr_name}";
- my @fields;
- if ($self->can($builder)) {
- @fields = $self->$builder($attr, $args); # re-use coderef from can()
- } elsif ($attr->has_type_constraint) {
- my $constraint = $attr->type_constraint;
- my $base_name = $constraint->name;
- my $tried_isa = 0;
- CONSTRAINT: while (defined($constraint)) {
- my $name = $constraint->name;
- $name = $attr->_isa_metadata if($name eq '__ANON__');
- if (eval { $name->can('meta') } && !$tried_isa++) {
- foreach my $class ($name->meta->class_precedence_list) {
- my $mangled_name = $class;
- $mangled_name =~ s/:+/_/g;
- my $builder = "_build_fields_for_type_${mangled_name}";
- if ($self->can($builder)) {
- @fields = $self->$builder($attr, $args);
- last CONSTRAINT;
- }
- }
- }
- if (defined($name)) {
- unless (defined($base_name)) {
- $base_name = "(anon subtype of ${name})";
- }
- my $mangled_name = $name;
- $mangled_name =~ s/:+/_/g;
- my $builder = "_build_fields_for_type_${mangled_name}";
- if ($self->can($builder)) {
- @fields = $self->$builder($attr, $args);
- last CONSTRAINT;
- }
- }
- $constraint = $constraint->parent;
- }
- if (!defined($constraint)) {
- confess "Can't build field ${attr_name} of type ${base_name} without $builder method or _build_fields_for_type_<type> method for type or any supertype";
- }
- } else {
- confess "Can't build field ${attr} without $builder method or type constraint";
- }
- return @fields;
- };
-
- implements _build_field_map => as {
- confess "Lazy field map building not supported by default";
- };
-
- implements _build_ordered_fields => as {
- my $self = shift;
- my $ordered = $self->sort_by_spec($self->column_order, [keys %{$self->_field_map}]);
- return [@{$self->_field_map}{@$ordered}];
- };
-
- implements _build_simple_field => as {
- my ($self, $class, $attr, $args) = @_;
- my $attr_name = $attr->name;
- my %extra;
- if (my $config = $args->{Field}{$attr_name}) {
- %extra = %$config;
- }
- my $field = $class->new(
- object => $self->object,
- attribute => $attr,
- name => $attr->name,
- location => join('-', $self->location, 'field', $attr->name),
- ctx => $self->ctx,
- %extra
- );
- return ($attr_name => $field);
- };
-
- implements _build_fields_for_type_Num => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(Number, $attr, $args);
- };
-
- implements _build_fields_for_type_Int => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(Number, $attr, $args);
- };
-
- implements _build_fields_for_type_Bool => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(Boolean, $attr, $args);
- };
-
- implements _build_fields_for_type_Password => as { return };
-
- implements _build_fields_for_type_Str => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(String, $attr, $args);
- };
-
- implements _build_fields_for_type_SimpleStr => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(String, $attr, $args);
- };
-
- implements _build_fields_for_type_DateTime => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(DateTime, $attr, $args);
- };
-
- implements _build_fields_for_type_Enum => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(String, $attr, $args);
- };
-
- implements _build_fields_for_type_ArrayRef => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(List, $attr, $args)
- };
-
- implements _build_fields_for_type_Reaction_InterfaceModel_Collection => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(Collection, $attr, $args)
- };
-
- implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
- my ($self, $attr, $args) = @_;
- return $self->_build_simple_field(RelatedObject, $attr, $args);
- };
-
- no Moose;
-
- no strict 'refs';
- delete ${__PACKAGE__ . '::'}{inner};
-
-};
-
-1;
-package Reaction::UI::ViewPort::GridView::Role::Actions;
-
-use strict;
-use warnings;
+package Reaction::UI::ViewPort::Role::Actions;
use Reaction::Role;
-use Reaction::UI::ViewPort::GridView::Action;
+use Reaction::UI::ViewPort::Action::Link;
role Actions, which {
my $obj = $self->current_collection;
my $loc = $self->location;
foreach my $proto (@{ $self->action_prototypes }) {
- my $action = Reaction::UI::ViewPort::GridView::Action->new
+ my $action = Reaction::UI::ViewPort::Action::Link->new
(
ctx => $ctx,
target => $obj,
projects / catagits/Reaction.git / commitdiff