the metadata fetcher
[bse.git] / site / cgi-bin / modules / BSE / MetaOwnerBase.pm
1 package BSE::MetaOwnerBase;
2 use strict;
3 use Carp 'confess';
4
5 our $VERSION = "1.005";
6
7 =head1 NAME
8
9 BSE::MetaOwnerBase - mix-in for objects that have metadata.
10
11 =head1 SYNOPSIS
12
13   my $file = ...
14   my @meta = $file->metadata;
15   my @text = $file->text_metadata;
16   my $meta = $file->meta_by_name($name);
17   my @names = $file->metanames;
18   my @info = $file->metainfo;
19   my @config = $file->meta_config;
20
21 =head1 DESCRIPTION
22
23 Provides generic metadata support methods.  These can be called on any
24 L<BSE::TB::ArticleFile> object, and possibly other objects in the
25 future.
26
27 =head1 PUBLIC METHODS
28
29 These can be called from anywhere, including templates:
30
31 =over
32
33 =item metadata
34
35 Return all metadata for the object (as metadata objects).
36
37 =cut
38
39 sub metadata {
40   my ($self) = @_;
41
42   require BSE::TB::Metadata;
43   return  BSE::TB::Metadata->getBy
44     (
45      file_id => $self->id,
46      owner_type => $self->meta_owner_type,
47     );
48 }
49
50 =item text_metadata
51
52 Return all metadata for the object with a content type of
53 C<text/plain>.
54
55 =cut
56
57 sub text_metadata {
58   my ($self) = @_;
59
60   require BSE::TB::Metadata;
61   return  BSE::TB::Metadata->getBy
62     (
63      file_id => $self->id,
64      owner_type => $self->meta_owner_type,
65      content_type => "text/plain",
66     );
67 }
68
69 =item meta_by_name
70
71 Retrieve metadata with a specific name.
72
73 Returns nothing if there is no metadata of that name.
74
75 =cut
76
77 sub meta_by_name {
78   my ($self, $name) = @_;
79
80   require BSE::TB::Metadata;
81   my ($result) = BSE::TB::Metadata->getBy
82     (
83      file_id => $self->id,
84      owner_type => $self->meta_owner_type,
85      name => $name
86     )
87       or return;
88
89   return $result;
90 }
91
92 =item meta_json_by_name
93
94 Retrieve metadata with a specific name and decode it as JSON,
95 returning a data structure.
96
97 Returns nothing if there is no metadata of that name, or if the
98 content type isn't a JSON content type or if the metadata cannot be
99 decoded as JSON.
100
101 =cut
102
103 sub meta_json_by_name {
104   my ($self, $name) = @_;
105
106   my $meta = $self->meta_by_name($name)
107     or return;
108
109   return $meta->retrieve_json;
110 }
111
112 =item metanames
113
114 Returns the names of each metadatum defined for the file.
115
116 =cut
117
118 sub metanames {
119   my ($self) = @_;
120
121   require BSE::TB::Metadata;
122   return BSE::TB::Metadata->getColumnBy
123     (
124      "name",
125      [
126       [ file_id => $self->id ],
127       [ owner_type => $self->meta_owner_type ],
128      ],
129     );
130
131 }
132
133 =item metainfo
134
135 Returns all but the value for metadata defined for the file.
136
137 This is useful to avoid loading large objects if the metadata happens
138 to be file content.
139
140 =cut
141
142 sub metainfo {
143   my ($self) = @_;
144
145   require BSE::TB::Metadata;
146   my @cols = grep $_ ne "value", BSE::TB::MetaEntry->columns;
147   return BSE::TB::Metadata->getColumnsBy
148     (
149      \@cols,
150      [
151       [ file_id => $self->id ],
152       [ owner_type => $self->meta_owner_type ],
153      ],
154     );
155 }
156
157 =item meta_config
158
159 Returns configured metadata fields for this object.
160
161 =cut
162
163 sub meta_config {
164   my ($self, $cfg) = @_;
165
166   $cfg || BSE::Cfg->single;
167
168   require BSE::MetaMeta;
169   my @metafields;
170   my $prefix = $self->meta_meta_cfg_prefix;
171   my @keys = $cfg->orderCS($self->meta_meta_cfg_section);
172   for my $name (@keys) {
173     my %opts = ( name => $name );
174     my $section = "$prefix $name";
175     for my $key (BSE::MetaMeta->keys) {
176       my $value = $cfg->entry($section, $key);
177       if (defined $value) {
178         $opts{$key} = $value;
179       }
180     }
181     push @metafields, BSE::MetaMeta->new(%opts, cfg => $cfg);
182   }
183
184   return @metafields;
185
186 }
187
188 =item all_meta_by_name
189
190 Retrieves all metadata for this owner type with the given name.
191
192 =cut
193
194 sub all_meta_by_name {
195   my ($class, $name) = @_;
196
197   require BSE::TB::Metadata;
198   return BSE::TB::Metadata->getBy
199     (
200      owner_type => $class->meta_owner_type,
201      name => $name,
202     );
203 }
204
205 =back
206
207 =head1 RESTRICTED METHODS
208
209 These are not accessible from templates.
210
211 =over
212
213 =item clear_metadata
214
215 Remove all metadata for this object.  Should be called when the object
216 is removed.
217
218 Restricted.
219
220 =cut
221
222 sub clear_metadata {
223   my ($self) = @_;
224
225   BSE::DB->run(bseClearArticleFileMetadata => $self->id, $self->meta_owner_type);
226 }
227
228 =item clear_app_metadata
229
230 Remove all application metadata for this object.
231
232 Restricted.
233
234 =cut
235
236 sub clear_app_metadata {
237   my ($self) = @_;
238
239   BSE::DB->run(bseClearArticleFileAppMetadata => $self->id, $self->meta_owner_type);
240 }
241
242 =item clear_sys_metadata
243
244 Remove all system metadata for this object.
245
246 Restricted.
247
248 =cut
249
250 sub clear_sys_metadata {
251   my ($self) = @_;
252
253   BSE::DB->run(bseClearArticleFileSysMetadata => $self->id, $self->meta_owner_type);
254 }
255
256 =item delete_meta_by_name
257
258 Remove a single piece of metadata from the object.
259
260 Restricted.
261
262 =cut
263
264 sub delete_meta_by_name {
265   my ($self, $name) = @_;
266
267   BSE::DB->run(bseDeleteArticleFileMetaByName => $self->id, $name, $self->meta_owner_type);
268 }
269
270 =item add_meta
271
272 Add metadata to the object.
273
274 Restricted.
275
276 =cut
277
278 sub add_meta {
279   my ($self, %opts) = @_;
280
281   my $value_text = delete $opts{value_text};
282   if ($value_text) {
283     utf8::encode($value_text);
284     $opts{value} = $value_text;
285   }
286
287   require BSE::TB::Metadata;
288   return BSE::TB::Metadata->make
289       (
290        file_id => $self->id,
291        owner_type => $self->meta_owner_type,
292        %opts,
293       );
294 }
295
296 sub restricted_method {
297   my ($self, $name) = @_;
298
299   return $name =~ /^(?:clear_|delete_|add_)/;
300 }
301
302 1;
303
304 =back
305
306 =cut