requires 'Test::Memory::Cycle' => 0;
requires 'DBIx::Class' => '0.07001';
requires 'SQL::Translator' => '0.08';
-requires 'Moose' => '0.22';
+requires 'Moose' => '0.28';
requires 'aliased' => 0;
requires 'DateTime';
requires 'DateTime::Span';
#print STDERR "$package \n";
#print STDERR $package->meta->blessed, " \n";
$package->meta->make_immutable;
-# (inline_accessor => 0, inline_destructor => 0,inline_constructor => 0,);
+ # (inline_accessor => 0, inline_destructor => 0,inline_constructor => 0,);
}
sub setup_and_cleanup {
metaclass => DomainModelAttribute,
);
- implements _build_collection_store => as { [] };
+ implements _build__collection_store => as { [] };
implements members => as {
my $self = shift;
=head1 PRIVATE METHODS
-_build_collection_store
+_build__collection_store
Builder method for attribute_collection_store, returns an empty arrayref
#};
#Oh man. I have a bad feeling about this one.
- implements _build_im_class => as {
+ implements _build__im_class => as {
my $self = shift;
- my $class = blessed $self || $self;
+ my $class = blessed($self) || $self;
$class =~ s/::Collection$//;
return $class;
};
- implements _build_collection_store => as {
+ implements _build__collection_store => as {
my $self = shift;
my $im_class = $self->_im_class;
[ $self->_source_resultset->search({}, {result_class => $im_class})->all ];
"Reaction::InterfaceModel::Collection::DBIC::Role::Where";
- implements _build_default_action_class_prefix => as {
+ implements _build__default_action_class_prefix => as {
shift->_im_class;
};
);
#DBIC::Collection would override this to use result_class for example
- implements _build_default_action_class_prefix => as {
+ implements _build__default_action_class_prefix => as {
my $self = shift;
ref $self || $self;
};
#little trick in case we call it in class context!
my $prefix = ref $self ?
$self->_default_action_class_prefix :
- $self->_build_default_action_class_prefix;
+ $self->_build__default_action_class_prefix;
return join "::", $prefix, 'Action', $action;
};
has builtin_object_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
has builtin_collection_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
- implements build_object_actions => as { {} };
- implements build_collection_actions => as { {} };
+ implements _build_object_actions => as { {} };
+ implements _build_collection_actions => as { {} };
- implements build_default_object_actions => as { [ qw/Update Delete/ ] };
- implements build_default_collection_actions => as { [ qw/Create DeleteAll/ ] };
+ implements _build_default_object_actions => as { [ qw/Update Delete/ ] };
+ implements _build_default_collection_actions => as { [ qw/Create DeleteAll/ ] };
- implements build_builtin_object_actions => as {
+ implements _build_builtin_object_actions => as {
{
Update => { name => 'Update', base => Update },
Delete => { name => 'Delete', base => Delete, attributes => [] },
};
};
- implements build_builtin_collection_actions => as {
+ implements _build_builtin_collection_actions => as {
{
Create => {name => 'Create', base => Create },
DeleteAll => {name => 'DeleteAll', base => DeleteAll, attributes => [] }
};
implements _all_object_actions => as {
- my $self = shift;
+ my $self = shift;
return $self->merge_hashes
($self->builtin_object_actions, $self->object_actions);
};
unless($model && $schema);
Class::MOP::load_class( $base );
Class::MOP::load_class( $schema );
- my $meta = eval {Class::MOP::load_class($model); } ?
+ my $meta = eval { Class::MOP::load_class($model); } ?
$model->meta : $base->meta->create($model, superclasses => [ $base ]);
# sources => undef, #default to qr/./
my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;;
$meta->make_mutable if $meta->is_immutable;
- $meta->add_method(_build_im_class => sub{ $object } );
+ $meta->add_method(_build__im_class => sub{ $object } );
#XXX as a default pass the domain model as a target_model until i come up with something
#better through the coercion method
my $def_act_args = sub {
};
}
#use Data::Dumper;
+ #print STDERR "\n" .$attr_name ." - ". $object . "\n";
#print STDERR Dumper(\%attr_opts);
return \%attr_opts;
};
#is => 'Bool' ? or leave it open
has lazy_fail =>
(is => 'ro', reader => 'is_lazy_fail', required => 1, default => 0);
-has lazy_build =>
- (is => 'ro', reader => 'is_lazy_build', required => 1, default => 0);
around _process_options => sub {
my $super = shift;
my ($class, $name, $options) = @_;
- my $fail = $options->{lazy_fail}; #will this autovivify?
- my $build = $options->{lazy_build};
+ my $fail = $options->{lazy_fail};
- if ( $fail || $build) {
+ if ( $fail ) {
confess("You may not use both lazy_build and lazy_fail for one attribute")
- if $fail && $build;
- confess("You may not supply a default value when using lazy_build or lazy_fail")
- if exists $options->{default};
+ if $fail && $options->{lazy_build};
$options->{lazy} = 1;
$options->{required} = 1;
-
- my $builder = ($name =~ /^_/) ? "_build${name}" : "build_${name}";
- $options->{default} = $fail ?
- sub { confess "${name} must be provided before calling reader" } :
- sub{ shift->$builder };
-
- $options->{clearer} ||= ($name =~ /^_/) ? "_clear${name}" : "clear_${name}"
- if $build;
+ $options->{default} = sub { confess "${name} must be provided before calling reader" };
}
#we are using this everywhere so might as well move it here.
$options->{predicate} ||= ($name =~ /^_/) ? "_has${name}" : "has_${name}"
if !$options->{required} || $options->{lazy};
-
$super->($class, $name, $options);
};
has description => (is => 'rw', isa => 'Str', lazy_fail => 1);
- # OR
- has description => (is => 'rw', isa => 'Str', lazy_build => 1);
- sub build_description{ "My Description" }
-
- # OR
- has _description => (is => 'rw', isa => 'Str', lazy_build => 1);
- sub _build_description{ "My Description" }
-
=head1 Method-naming conventions
Reaction::Meta::Attribute will never override the values you set for method names,
attribute names preceeded by "has_" or "build_". e.g.
#auto generates "_has_description" and expects "_build_description"
- has _description => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has _description => (is => 'rw', isa => 'Str', lazy_fail => 1);
#auto generates "has_description" and expects "build_description"
- has description => (is => 'rw', isa => 'Str', lazy_build => 1);
+ has description => (is => 'rw', isa => 'Str', lazy_fail => 1);
=head2 Predicate generation
=head2 lazy_fail
-=head2 lazy_build
-
-lazy_build will lazily build to the return value of a user-supplied builder sub
- The builder sub will recieve C<$self> as the first argument.
-
-lazy_fail will simply fail if it is called without first having set the value.
+lazy_fail will fail if it is called without first having set the value.
=head1 AUTHORS
my ($self, $object, $value) = @_;
confess "Can't check_valid_value when no valid_values set"
unless $self->has_valid_values;
+ confess join " - ", blessed($object), $self->name
+ unless ref $self->valid_values;
my $valid = $self->valid_values->($object, $self);
if ($self->type_constraint
&& ($self->type_constraint->name eq 'ArrayRef'
has action_viewport_map => (isa => 'HashRef', is => 'rw', lazy_build => 1);
has action_viewport_args => (isa => 'HashRef', is => 'rw', lazy_build => 1);
-sub build_action_viewport_map {
+sub _build_action_viewport_map {
return {
list => ListView,
view => ObjectView,
};
}
-sub build_action_viewport_args {
+sub _build_action_viewport_args {
my $self = shift;
return { list =>
{ action_prototypes =>
has 'source_file' => (is => 'rw', lazy_fail => 1);
has 'file_extension'=> (isa => 'Str', is => 'rw', lazy_build => 1);
- implements build_file_extension => as { 'html' };
+ implements _build_file_extension => as { 'html' };
implements 'BUILD' => as {
my ($self, $args) = @_;
has 'tt_view' => (is => 'rw', isa => View, lazy_fail => 1);
- implements build_file_extension => as { 'tt' };
+ implements _build_file_extension => as { 'tt' };
implements 'BUILD' => as {
my ($self, $args) = @_;
has 'rendering_context_class' => (is => 'ro', lazy_build => 1);
+ implements '_build_layout_set_class' => as {
+ my ($self) = @_;
+ return $self->find_related_class('LayoutSet');
+ };
+
+ implements '_build_rendering_context_class' => as {
+ my ($self) = @_;
+ return $self->find_related_class('RenderingContext');
+ };
+
implements 'COMPONENT' => as {
my ($class, $app, $args) = @_;
return $class->new(%{$args||{}}, app => $app);
confess "Unable to find related ${rel} class for ${own_class}";
};
- implements 'build_layout_set_class' => as {
- my ($self) = @_;
- return $self->find_related_class('LayoutSet');
- };
-
implements 'layout_set_args_for' => as {
my ($self, $name) = @_;
return (name => $name, search_path => $self->layout_search_path);
);
};
- implements 'build_rendering_context_class' => as {
- my ($self) = @_;
- return $self->find_related_class('RenderingContext');
- };
-
implements 'rendering_context_args_for' => as {
return ();
};
has ctx => (isa => 'Catalyst', is => 'ro', required => 1);
has column_order => (is => 'rw');
- implements build_layout => as {
+ implements _build_layout => as {
'';
};
my @field_map;
my $action = $self->action;
foreach my $attr ($action->parameter_attributes) {
- push(@field_map, $self->build_fields_for($attr => $args));
+ push(@field_map, $self->_build_fields_for($attr => $args));
}
$self->_field_map({ @field_map });
}
$self->close_label($self->close_label_close);
};
- implements build_fields_for => as {
+ implements _build_fields_for => as {
my ($self, $attr, $args) = @_;
my $attr_name = $attr->name;
#TODO: DOCUMENT ME!!!!!!!!!!!!!!!!!
- my $builder = "build_fields_for_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()
foreach my $class ($name->meta->class_precedence_list) {
my $mangled_name = $class;
$mangled_name =~ s/:+/_/g;
- my $builder = "build_fields_for_type_${mangled_name}";
+ my $builder = "_build_fields_for_type_${mangled_name}";
if ($self->can($builder)) {
@fields = $self->$builder($attr, $args);
last CONSTRAINT;
}
my $mangled_name = $name;
$mangled_name =~ s/:+/_/g;
- my $builder = "build_fields_for_type_${mangled_name}";
+ 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";
+ 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 {
+ implements _build_field_map => as {
confess "Lazy field map building not supported by default";
};
- implements build_ordered_fields => as {
+ 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 {
+ implements _build_simple_field => as {
my ($self, $class, $attr, $args) = @_;
my $attr_name = $attr->name;
my %extra;
return ($attr_name => $field);
};
- implements build_fields_for_type_Num => as {
+ implements _build_fields_for_type_Num => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Number, $attr, $args);
+ return $self->_build_simple_field(Number, $attr, $args);
};
- implements build_fields_for_type_Int => as {
+ implements _build_fields_for_type_Int => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Number, $attr, $args);
+ return $self->_build_simple_field(Number, $attr, $args);
};
- implements build_fields_for_type_Bool => as {
+ implements _build_fields_for_type_Bool => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Boolean, $attr, $args);
+ return $self->_build_simple_field(Boolean, $attr, $args);
};
- implements build_fields_for_type_File => as {
+ implements _build_fields_for_type_File => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(File, $attr, $args);
+ return $self->_build_simple_field(File, $attr, $args);
};
- implements build_fields_for_type_Str => as {
+ 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
- return $self->build_simple_field(ChooseOne, $attr, $args);
+ return $self->_build_simple_field(ChooseOne, $attr, $args);
}
- return $self->build_simple_field(Text, $attr, $args);
+ return $self->_build_simple_field(Text, $attr, $args);
};
- implements build_fields_for_type_SimpleStr => as {
+ implements _build_fields_for_type_SimpleStr => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(String, $attr, $args);
+ return $self->_build_simple_field(String, $attr, $args);
};
- implements build_fields_for_type_Password => as {
+ implements _build_fields_for_type_Password => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Password, $attr, $args);
+ return $self->_build_simple_field(Password, $attr, $args);
};
- implements build_fields_for_type_DateTime => as {
+ implements _build_fields_for_type_DateTime => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(DateTime, $attr, $args);
+ return $self->_build_simple_field(DateTime, $attr, $args);
};
- implements build_fields_for_type_Enum => as {
+ implements _build_fields_for_type_Enum => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(ChooseOne, $attr, $args);
+ return $self->_build_simple_field(ChooseOne, $attr, $args);
};
#implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
- implements build_fields_for_type_DBIx_Class_Row => as {
+ implements _build_fields_for_type_DBIx_Class_Row => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(ChooseOne, $attr, $args);
+ return $self->_build_simple_field(ChooseOne, $attr, $args);
};
- implements build_fields_for_type_ArrayRef => as {
+ implements _build_fields_for_type_ArrayRef => as {
my ($self, $attr, $args) = @_;
if ($attr->has_valid_values) {
- return $self->build_simple_field(ChooseMany, $attr, $args)
+ return $self->_build_simple_field(ChooseMany, $attr, $args)
} else {
- return $self->build_simple_field(HiddenArray, $attr, $args)
+ return $self->_build_simple_field(HiddenArray, $attr, $args)
}
};
- implements build_fields_for_type_DateTime_Spanset => as {
+ implements _build_fields_for_type_DateTime_Spanset => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(TimeRange, $attr, $args);
+ return $self->_build_simple_field(TimeRange, $attr, $args);
};
no Moose;
has value => (
is => 'rw', lazy_build => 1, trigger_adopt('value'),
- clearer => 'clear_value',
);
has label => (isa => 'Str', is => 'rw', lazy_build => 1);
confess "Should have both object and attribute or neither"; }
};
- implements build_label => as {
+ implements _build_label => as {
my ($self) = @_;
return join(' ', map { ucfirst } split('_', $self->name));
};
- implements build_value => as {
+ implements _build_value => as {
my ($self) = @_;
if ($self->has_attribute) {
my $reader = $self->attribute->get_read_method;
default => sub { {true => 'Yes', false => 'No'} }
);
- implements build_value_string => as {
+ implements _build_value_string => as {
my $self = shift;
my $val = $self->value;
if(!defined $val || $val eq "" || "$val" eq '0'){
isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
);
- override build_value => sub {
+ override _build_value => sub {
return [super()->members];
};
- implements build_value_names => as {
+ implements _build_value_names => as {
my $self = shift;
my @all = @{$self->value||[]};
my $meth = $self->value_map_method;
isa => 'Str', is => 'rw', required => 1, default => sub { "%F %H:%M:%S" }
);
- implements build_value_string => as {
+ implements _build_value_string => as {
my $self = shift;
my $value = eval { $self->value };
return '' unless $self->has_value;
isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
);
- override build_value => sub {
+ override _build_value => sub {
return super() || [];
};
- implements build_value_names => as {
+ implements _build_value_names => as {
my $self = shift;
my @all = @{$self->value||[]};
my $meth = $self->value_map_method;
- my @names = map { blessed $_ ? $_->$meth : $_ } @all;
+ my @names = map { blessed($_) ? $_->$meth : $_ } @all;
return [ sort @names ];
};
isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
);
- implements build_value_string => as {
+ implements _build_value_string => as {
my $self = shift;
my $meth = $self->value_map_method;
my $value = $self->value;
- return blessed $value ? $value->$meth : $value;
+ return blessed($value) ? $value->$meth : $value;
};
};
}
};
- implements build_label => as {
+ 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;
};
- implements build_value => as {
+ implements _build_value => as {
my ($self) = @_;
if ($self->has_attribute) {
my $reader = $self->attribute->get_read_method;
}
};
- override build_value => sub {
+ override _build_value => sub {
return super() || [];
};
}
};
- implements build_valid_values => as {
+ implements _build_valid_values => as {
my $self = shift;
return [ $self->attribute->all_valid_values($self->action) ];
};
- implements build_value_choices => sub{
+ implements _build_value_choices => sub{
my $self = shift;
my @pairs = map{{value => $self->obj_to_str($_), name => $self->obj_to_name($_)}}
@{ $self->valid_values };
isa => 'Str', is => 'rw', required => 1, default => sub { "%F %H:%M:%S" }
);
- implements build_value_string => as {
+ implements _build_value_string => as {
my $self = shift;
# XXX
is_weak_ref => 1
);
- implements build_value_string => as {
+ implements _build_value_string => as {
my $self = shift;
#return '' unless $self->has_value;
#return $self->value_string;
shift->clear_entities; #clear the entitiesis the current collection changes, duh
};
- implements build_entity_class => as { Entity };
+ implements _build_entity_class => as { Entity };
- implements build_field_order => as {
+ implements _build_field_order => as {
my ($self) = @_;
my %excluded = map { $_ => undef }
@{ $self->has_exclude_fields ? $self->exclude_fields : [] };
return $ordered;
};
- implements build_current_collection => as {
+ implements _build_current_collection => as {
shift->collection;
};
- implements build_field_labels => as {
+ implements _build_field_labels => as {
my $self = shift;
my %labels;
for my $field ( @{$self->field_order}){
return \%labels;
};
- implements build_entities => as {
+ implements _build_entities => as {
my ($self) = @_;
my (@entities, $i);
my $args = $self->has_entity_args ? $self->entity_args : {};
$self->label( $self->label->($self->target) ) if ref $self->label eq 'CODE';
};
- implements build_uri => as{
+ implements _build_uri => as{
my $self = shift;
my $c = $self->ctx;
my ($c_name, $a_name, @rest) = @{ $self->action->($self->target, $c) };
$self->field_args( {Field => $field_args} ) if ref $field_args;
};
- implements build_fields => as {
+ implements _build_fields => as {
my ($self) = @_;
my $obj = $self->object;
my $args = $self->has_field_args ? $self->field_args : {};
implements get_builder_for => as {
my ($self, $attr) = @_;
my $attr_name = $attr->name;
- my $builder = "build_fields_for_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;
foreach my $class ($name->meta->class_precedence_list) {
my $mangled_name = $class;
$mangled_name =~ s/:+/_/g;
- my $builder = "build_fields_for_type_${mangled_name}";
+ my $builder = "_build_fields_for_type_${mangled_name}";
return $builder if $self->can($builder);
}
}
}
my $mangled_name = $name;
$mangled_name =~ s/:+/_/g;
- my $builder = "build_fields_for_type_${mangled_name}";
+ 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";
+ 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 {
+ implements _build_simple_field => as {
my ($self, $class, $obj, $attr, $args) = @_;
my $attr_name = $attr->name;
my %extra;
);
};
- implements build_fields_for_type_Num => as {
+ 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);
+ return $self->_build_simple_field(Number, $obj, $attr, $args);
};
- implements build_fields_for_type_Int => as {
+ 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);
+ return $self->_build_simple_field(Number, $obj, $attr, $args);
};
- implements build_fields_for_type_Bool => as {
+ 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);
+ return $self->_build_simple_field(Boolean, $obj, $attr, $args);
};
- implements build_fields_for_type_Password => as { return };
+ implements _build_fields_for_type_Password => as { return };
- implements build_fields_for_type_Str => as {
+ 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);
+ return $self->_build_simple_field(String, $obj, $attr, $args);
};
- implements build_fields_for_type_SimpleStr => as {
+ 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);
+ return $self->_build_simple_field(String, $obj, $attr, $args);
};
- implements build_fields_for_type_DateTime => as {
+ 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);
+ return $self->_build_simple_field(DateTime, $obj, $attr, $args);
};
- implements build_fields_for_type_Enum => as {
+ 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);
+ return $self->_build_simple_field(String, $obj, $attr, $args);
};
};
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_action_prototypes => as { [] };
- implements build_actions => as {
+ implements _build_actions => as {
my ($self) = @_;
my (@act, $i);
my $ctx = $self->ctx;
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_action_prototypes => as { [] };
- implements build_actions => as {
+ implements _build_actions => as {
my ($self) = @_;
my (@act, $i);
my $ctx = $self->ctx;
has order_by => (isa => 'Str', is => 'rw', trigger_adopt('order_by'));
has order_by_desc => (isa => 'Int', is => 'rw', trigger_adopt('order_by'), lazy_build => 1);
- implements build_order_by_desc => as { 0 };
+ implements _build_order_by_desc => as { 0 };
implements adopt_order_by => as {
shift->clear_current_collection;
};
- around build_current_collection => sub {
+ around _build_current_collection => sub {
my $orig = shift;
my ($self) = @_;
my $collection = $orig->(@_);
has pager => (isa => 'Data::Page', is => 'rw', lazy_build => 1);
has page => (isa => 'Int', is => 'rw', lazy_build => 1, trigger_adopt('page'));
has per_page => (isa => 'Int', is => 'rw', lazy_build => 1, trigger_adopt('page'));
+ has per_page_max => (isa => 'Int', is => 'rw', lazy_build => 1);
- implements build_page => as { 1 };
- implements build_per_page => as { 10 };
+ implements _build_page => as { 1 };
+ implements _build_per_page => as { 10 };
+ implements _build_per_page_max => as { 100 };
- implements build_pager => as { shift->current_collection->pager };
+ implements _build_pager => as { shift->current_collection->pager };
implements adopt_page => as {
my ($self) = @_;
#$self->clear_paged_collection;
- $self->clear_current_collection;
+
$self->clear_pager;
+ $self->clear_current_collection;
};
- around accept_events => sub { ('page', shift->(@_)); };
+ around accept_events => sub { ('page','per_page', shift->(@_)); };
#implements build_paged_collection => as {
# my ($self) = @_;
# return $collection->where(undef, {rows => $self->per_page})->page($self->page);
#};
- around build_current_collection => sub {
+ around _build_current_collection => sub {
my $orig = shift;
my ($self) = @_;
my $collection = $orig->(@_);
#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?
- implements build_entity_class => as { WithActions };
+ implements _build_entity_class => as { WithActions };
#You'se has to goes aways. sorry.
#if i saved the args as an attribute i could probably get around this....
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));
+ push(@field_map, $self->_build_fields_for($attr => $args));
}
my %field_map = @field_map;
}
};
- implements build_fields_for => as {
+ implements _build_fields_for => as {
my ($self, $attr, $args) = @_;
my $attr_name = $attr->name;
- my $builder = "build_fields_for_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()
foreach my $class ($name->meta->class_precedence_list) {
my $mangled_name = $class;
$mangled_name =~ s/:+/_/g;
- my $builder = "build_fields_for_type_${mangled_name}";
+ my $builder = "_build_fields_for_type_${mangled_name}";
if ($self->can($builder)) {
@fields = $self->$builder($attr, $args);
last CONSTRAINT;
}
my $mangled_name = $name;
$mangled_name =~ s/:+/_/g;
- my $builder = "build_fields_for_type_${mangled_name}";
+ 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";
+ 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";
confess "Lazy field map building not supported by default";
};
- implements build_ordered_fields => as {
+ 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 {
+ implements _build_simple_field => as {
my ($self, $class, $attr, $args) = @_;
my $attr_name = $attr->name;
my %extra;
return ($attr_name => $field);
};
- implements build_fields_for_type_Num => as {
+ implements _build_fields_for_type_Num => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Number, $attr, $args);
+ return $self->_build_simple_field(Number, $attr, $args);
};
- implements build_fields_for_type_Int => as {
+ implements _build_fields_for_type_Int => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Number, $attr, $args);
+ return $self->_build_simple_field(Number, $attr, $args);
};
- implements build_fields_for_type_Bool => as {
+ implements _build_fields_for_type_Bool => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Boolean, $attr, $args);
+ return $self->_build_simple_field(Boolean, $attr, $args);
};
- implements build_fields_for_type_Password => as { return };
+ implements _build_fields_for_type_Password => as { return };
- implements build_fields_for_type_Str => as {
+ implements _build_fields_for_type_Str => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(String, $attr, $args);
+ return $self->_build_simple_field(String, $attr, $args);
};
- implements build_fields_for_type_SimpleStr => as {
+ implements _build_fields_for_type_SimpleStr => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(String, $attr, $args);
+ return $self->_build_simple_field(String, $attr, $args);
};
- implements build_fields_for_type_DateTime => as {
+ implements _build_fields_for_type_DateTime => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(DateTime, $attr, $args);
+ return $self->_build_simple_field(DateTime, $attr, $args);
};
- implements build_fields_for_type_Enum => as {
+ implements _build_fields_for_type_Enum => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(String, $attr, $args);
+ return $self->_build_simple_field(String, $attr, $args);
};
- implements build_fields_for_type_ArrayRef => as {
+ implements _build_fields_for_type_ArrayRef => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(List, $attr, $args)
+ return $self->_build_simple_field(List, $attr, $args)
};
- implements build_fields_for_type_Reaction_InterfaceModel_Collection => as {
+ implements _build_fields_for_type_Reaction_InterfaceModel_Collection => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(Collection, $attr, $args)
+ return $self->_build_simple_field(Collection, $attr, $args)
};
- implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
+ implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
my ($self, $attr, $args) = @_;
- return $self->build_simple_field(RelatedObject, $attr, $args);
+ return $self->_build_simple_field(RelatedObject, $attr, $args);
};
no Moose;
isa => 'HashRef', is => 'rw', init_arg => 'fields',
clearer => '_clear_field_map',
predicate => '_has_field_map',
- set_or_lazy_build('field_map'),
+ lazy_build => 1,
);
has on_next_callback => (
implements fields => as { shift->_field_map };
- implements build_range_vps => as { [] };
+ implements _build_range_vps => as { [] };
implements spanset => as {
my ($self) = @_;
parent => $self
};
my $count = scalar(@{$self->range_vps});
- my $field = $self->build_simple_field(TimeRange, 'range-'.$count, $args);
+ my $field = $self->_build_simple_field(TimeRange, 'range-'.$count, $args);
my $d = DateTime::Format::Duration->new( pattern => '%s' );
if ($d->format_duration( $self->spanset->intersection($field->value)->duration ) > 0) {
# XXX - Stop using the stash here?
}
};
- implements build_field_map => as {
+ implements _build_field_map => as {
my ($self) = @_;
my %map;
foreach my $field (@{$self->range_vps}) {
return \%map;
};
- implements build_field_names => as {
+ implements _build_field_names => as {
my ($self) = @_;
return [
(map { $_->name } @{$self->range_vps}),
return !defined($error);
};
- implements build_simple_field => as {
+ implements _build_simple_field => as {
my ($self, $class, $name, $args) = @_;
return $class->new(
name => $name,
);
};
- implements build_time_to => as {
+ implements _build_time_to => as {
my ($self) = @_;
- return $self->build_simple_field(DateTime, 'time_to', {});
+ return $self->_build_simple_field(DateTime, 'time_to', {});
};
- implements build_time_from => as {
+ implements _build_time_from => as {
my ($self) = @_;
- return $self->build_simple_field(DateTime, 'time_from', {});
+ return $self->_build_simple_field(DateTime, 'time_from', {});
};
- implements build_repeat_to => as {
+ implements _build_repeat_to => as {
my ($self) = @_;
- return $self->build_simple_field(DateTime, 'repeat_to', {});
+ return $self->_build_simple_field(DateTime, 'repeat_to', {});
};
- implements build_repeat_from => as {
+ implements _build_repeat_from => as {
my ($self) = @_;
- return $self->build_simple_field(DateTime, 'repeat_from', {});
+ return $self->_build_simple_field(DateTime, 'repeat_from', {});
};
- implements build_pattern => as {
+ implements _build_pattern => as {
my ($self) = @_;
- return $self->build_simple_field(String, 'pattern', {});
+ return $self->_build_simple_field(String, 'pattern', {});
};
implements next => as {
Arguments: $to_add
-=head2 build_simple_field
+=head2 _build_simple_field
Arguments: $class, $name, $args
where $class is an object, $name is a scalar and $args is a hashref
has id => (isa => 'Str', is => 'ro', lazy_build => 1);
has name => (isa => 'Str', is => 'ro', lazy_build => 1);
- implements build_id => as { shift->viewport->event_id_for('value'); };
- implements build_name => as { shift->viewport->event_id_for('value'); };
+ implements _build_id => as { shift->viewport->event_id_for('value'); };
+ implements _build_name => as { shift->viewport->event_id_for('value'); };
widget renders [qw/label field message/
=> { id => func('self', 'id'),
=head1 METHODS
-=head2 build_id
+=head2 _build_id
Returns the viewport's C<event_id_for('value')>
-=head2 build_name
+=head2 _build_name
Returns the viewport's C<event_id_for('value')>
is => 'ro', required => 1,
default => sub { Reaction::UI::FocusStack->new },
);
-
- implements build_view => as {
+
+ implements _build_view => as {
my ($self) = @_;
return $self->ctx->view($self->view_name);
};
-
+
implements flush => as {
my ($self) = @_;
$self->flush_events;
$self->flush_view;
};
-
+
implements flush_events => as {
my ($self) = @_;
my $ctx = $self->ctx;
$self->focus_stack->apply_events($ctx, $param_hash);
}
};
-
+
implements flush_view => as {
my ($self) = @_;
return if $self->ctx->res->status =~ /^3/ || length($self->ctx->res->body);
};
# required by old Renderer::XHTML
-
+
implements render_viewport => as {
my ($self, $vp) = @_;
return unless $vp;
# More commonly, as Reaction::UI::RootController creates one for you:
my $window = $ctx->stash->{window};
- # Resolve current events and render the view of the UI
+ # Resolve current events and render the view of the UI
# elements of this Window:
# This is called by the end action of Reaction::UI::RootController
$window->flush();
#when I have time I will write test cases that cover all the other bases
#it's just kind of a pain in the ass right now and I am behind on a lot of other shit.
-sub build_im_schema{
+sub _build_im_schema{
my $self = shift;
my $reflector = Reaction::InterfaceModel::Reflector::DBIC->new;
'Reaction::InterfaceModel::Collection::Virtual::ResultSet',
"Collection ISA virtual resultset"
);
- Test::More::can_ok($collection, '_build_im_class');
+ Test::More::can_ok($collection, '_build__im_class');
Test::More::is(
- $collection->_build_im_class,
+ $collection->_build__im_class,
"RTest::TestIM::${_}",
"Collection has correct _im_class"
);
Test::More::isa_ok($member, $collection->_im_class);
my $ctx = $self->simple_mock_context;
- foreach my $action_name (qw/Update Delete Create/){
+ foreach my $action_name (qw/Update Delete DeleteAll Create/){
- my $target_im = $action_name eq 'Create' ? $collection : $member;
+ my $target_im = $action_name =~ /(?:Create|DeleteAll)/ ? $collection : $member;
my $action = $target_im->action_for($action_name, ctx => $ctx);
Test::More::isa_ok( $action, "Reaction::InterfaceModel::Action",
"${action_name} action has correct name"
);
- my $base = 'Reaction::InterfaceModel::Action::DBIC' .
- ($action_name eq 'Create' ? '::ResultSet::Create' : "::Result::${action_name}");
- Test::More::isa_ok($action, $base, 'Create action has correct base');
+ my $base = 'Reaction::InterfaceModel::Action::DBIC'.
+ ($action_name =~ /(?:Create|DeleteAll)/
+ ? "::ResultSet::${action_name}" : "::Result::${action_name}");
+ Test::More::isa_ok($action, $base, "${action_name} has correct base");
my %attrs = map { $_->name => $_ } $action->parameter_attributes;
my $attr_num;
- if($action_name eq 'Delete'){next; }
+ if($action_name =~ /Delete/){next; }
elsif($sm eq "Bar"){$attr_num = 4; }
elsif($sm eq "Baz"){$attr_num = 1; }
elsif($sm eq "Foo"){$attr_num = 3; }
projects / catagits/Reaction.git / commitdiff