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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
package UR::Object::Tag;
#TODO: update these to be UR::Value objects instead of some ancient hack
=pod
=head1 NAME
UR::Object::Tag - Transitory attribute tags for a UR::Object at a given time.
=head1 SYNOPSIS
if (my @attribs = grep { $_->type eq 'invalid' } $obj->attribs()) {
print $obj->display_name . " has invalid attributes. They are:\n";
for my $atrib (@attribs) {
print join(",",$attrib->properties) . ":" . $attrib->desc . "\n";
}
}
Project H_NHF00 has invalid attributes, they are:
project_subdirectory : Directory does not exist.
target, status : Target cannot be null for projects with an active status.
=head1 DESCRIPTION
Objects of this class are created by create_attribs() on classes
derived from UR::Object. They are retrieved by
UR::Object->attribs().
=head1 INHERITANCE
This class inherits from UR::ModuleBase.
=head1 OBJECT METHODS
=over 4
=item type
A single-word description of the attribute which categorizes the
attribute. Common attribute types are:
=over 6
=item invalid
Set when the object has invalid properties and cannot be saved.
=item changed
Set when the object is different than its "saved" version.
=item hidden
Set when the object has properties which should not be shown.
=item editable
Set when some part of the object is editable in the current context.
=item warning
Set when a warning about the state of the object is in effect.
=item match
Set when a search which is in effect matches this object's property(s).
=item comment
Set when this attribute is just an informational message.
=back
=item properties
A list of properties to which the attribute applies. This is null
when the attribute applies to the whole object, but typically returns
one property name. Occasionally, it returns more than one property.
Very rarely (currently never), the property may be in the form of an
arrayref like: [ class_name, id, property_name ], in which case the
property may actually be that of another related object.
=item desc
A string of text giving detail to the attribute.
=back
=head1 CLASS METHODS
=over 4
=item create
Makes a new UR::Object::Tag.
=item delete
Throws one away.
=item filter
Sets/gets a filter to be applied to all attribute lists returned in
the application. This gives the application developer final veto
power over expressed attributes in the app. In most cases, developers
will write view components which use attributes, and will ignore
them rather than plug-in at this low level to augment/mangle/suppress.
The filter will be given an object reference and a reference to an
array of attributes which are tentatively to be delivered for the
object.
=cut
# set up package
require 5.006_000;
use warnings;
use strict;
our $VERSION = "0.47"; # UR $VERSION;
# set up module
use base qw(UR::ModuleBase);
our (@EXPORT, @EXPORT_OK);
@EXPORT = qw();
@EXPORT_OK = qw();
##- use UR::Util;
our %default_values =
(
type => undef,
properties => [],
desc => undef
);
UR::Util->generate_readwrite_methods(%default_values);
*type_name = \&type;
*property_names = \&properties;
*description = \&description;
sub create($@)
{
my ($class, @initial_prop) = @_;
my $self = bless({%default_values,@initial_prop},$class);
if (not ref($self->{properties}) eq 'ARRAY') {
$self->{properties} = [ $self->{properties} ];
}
return $self;
}
sub delete($)
{
UR::DeletedRef->bury($_[0])
}
our $filter;
sub filter
{
if (@_ > 1)
{
my $old = $filter;
$filter = $_[1];
return $old;
}
return $filter;
}
sub __display_name__ {
my $self = shift;
my $desc = $self->desc;
my $prefix = uc($self->type);
my @properties = map { "'$_'" } $self->properties;
my $prop_noun = scalar(@properties) > 1 ? 'properties' : 'property';
my $msg = "$prefix: $prop_noun " . join(', ', @properties) . ": $desc";
return $msg;
}
1;
__END__
=pod
=back
=head1 SEE ALSO
UR::Object(3)
=cut
#$Header$
|
