1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
package Reaction::InterfaceModel::Object;
use metaclass 'Reaction::Meta::InterfaceModel::Object::Class';
use Reaction::Meta::Attribute;
use Reaction::Class;
use namespace::clean -except => [ qw(meta) ];
has _action_class_map =>
(is => 'rw', isa => 'HashRef', required => 1, default => sub{ {} },
metaclass => 'Reaction::Meta::Attribute');
has _default_action_class_prefix =>
(
is => 'ro',
isa => 'Str',
lazy_build => 1,
metaclass => 'Reaction::Meta::Attribute',
);
#DBIC::Collection would override this to use result_class for example
sub _build__default_action_class_prefix {
my $self = shift;
ref $self || $self;
};
#just a little convenience
sub parameter_attributes {
shift->meta->parameter_attributes;
};
#just a little convenience
sub domain_models {
shift->meta->domain_models;
};
sub _default_action_class_for {
my ($self, $action) = @_;
confess("Wrong arguments") unless $action;
#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;
return join "::", $prefix, 'Action', $action;
};
sub _action_class_for {
my ($self, $action) = @_;
confess("Wrong arguments") unless $action;
if (defined (my $class = $self->_action_class_map->{$action})) {
return $class;
}
return $self->_default_action_class_for($action);
};
sub action_for {
my ($self, $action, %args) = @_;
confess("Wrong arguments") unless $action;
my $class = $self->_action_class_for($action);
%args = (
%{$self->_default_action_args_for($action)},
%args,
%{$self->_override_action_args_for($action)},
);
return $class->new(%args);
};
#this really needs to be smarter, fine for CRUD, shit for anything else
# massive fucking reworking needed here, really
sub _default_action_args_for { {} };
sub _override_action_args_for { {} };
__PACKAGE__->meta->make_immutable;
1;
__END__;
=head1 NAME
Reaction::Class::InterfaceModel::Object
=head1 SYNOPSIS
=head1 DESCRIPTION
InterfaceModel Object base class.
=head1 Attributes
=head2 _action_class_map
RW, isa HashRef - Returns an empty hashref by default. It will hold a series of actions
as keys with their corresponding action classes as values.
=head2 _default_action_class_prefix
RO, isa Str - Default action class prefix. Lazy build by default to the value
returned by C<_build_default_action_class_prefix> which is C<ref $self || $self>.
=head1 Methods
=head2 parameter_attributes
=head2 domain_models
Shortcuts for these same subs in meta. They will return attribute objects that are of
the correct type, L<Reaction::Meta::InterfaceModel::Object::ParameterAttribute> and
L<Reaction::Meta::InterfaceModel::Object::DomainModelAttribute>
=head2 _default_action_class_for $action
Provides the default package name for the C<$action> action-class.
It defaults to the value of C<_default_action_class_prefix> followed by
C<::Action::$action>
#for MyApp::Foo, returns MyApp::Foo::Action::Create
$obj->_default_action_class_for('Create');
=head2 _action_class_for $action
Return the action class for an action name. Will search
C<_action_class_map> or, if not found, use the value of
C<_default_action_class_for>
=head2 action_for $action, %args
Will return a new instance of C<$action>. If specified,
%args will be passed through to C<new> as is.
=head2 _default_action_args_for
By default will return an empty hashref
=head2 _override_action_args_for
Returns empty hashref by default.
=head1 SEE ALSO
L<Reaction::InterfaceModel::ObjectClass>
=head1 AUTHORS
See L<Reaction::Class> for authors.
=head1 LICENSE
See L<Reaction::Class> for the license.
=cut
|
