metadata for articles
[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.003";
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 metanames
93
94 Returns the names of each metadatum defined for the file.
95
96 =cut
97
98 sub metanames {
99   my ($self) = @_;
100
101   require BSE::TB::Metadata;
102   return BSE::TB::Metadata->getColumnBy
103     (
104      "name",
105      [
106       [ file_id => $self->id ],
107       [ owner_type => $self->meta_owner_type ],
108      ],
109     );
110
111 }
112
113 =item metainfo
114
115 Returns all but the value for metadata defined for the file.
116
117 This is useful to avoid loading large objects if the metadata happens
118 to be file content.
119
120 =cut
121
122 sub metainfo {
123   my ($self) = @_;
124
125   require BSE::TB::Metadata;
126   my @cols = grep $_ ne "value", BSE::TB::MetaEntry->columns;
127   return BSE::TB::Metadata->getColumnsBy
128     (
129      \@cols,
130      [
131       [ file_id => $self->id ],
132       [ owner_type => $self->meta_owner_type ],
133      ],
134     );
135 }
136
137 =item meta_config
138
139 Returns configured metadata fields for this object.
140
141 =cut
142
143 sub meta_config {
144   my ($self, $cfg) = @_;
145
146   $cfg || BSE::Cfg->single;
147
148   require BSE::MetaMeta;
149   my @metafields;
150   my $prefix = $self->meta_meta_cfg_prefix;
151   my @keys = $cfg->orderCS($self->meta_meta_cfg_section);
152   for my $name (@keys) {
153     my %opts = ( name => $name );
154     my $section = "$prefix $name";
155     for my $key (BSE::MetaMeta->keys) {
156       my $value = $cfg->entry($section, $key);
157       if (defined $value) {
158         $opts{$key} = $value;
159       }
160     }
161     push @metafields, BSE::MetaMeta->new(%opts, cfg => $cfg);
162   }
163
164   return @metafields;
165
166 }
167
168 =back
169
170 =head1 RESTRICTED METHODS
171
172 These are not accessible from templates.
173
174 =over
175
176 =item clear_metadata
177
178 Remove all metadata for this object.  Should be called when the object
179 is removed.
180
181 Restricted.
182
183 =cut
184
185 sub clear_metadata {
186   my ($self) = @_;
187
188   BSE::DB->run(bseClearArticleFileMetadata => $self->id, $self->meta_owner_type);
189 }
190
191 =item clear_app_metadata
192
193 Remove all application metadata for this object.
194
195 Restricted.
196
197 =cut
198
199 sub clear_app_metadata {
200   my ($self) = @_;
201
202   BSE::DB->run(bseClearArticleFileAppMetadata => $self->id, $self->meta_owner_type);
203 }
204
205 =item clear_sys_metadata
206
207 Remove all system metadata for this object.
208
209 Restricted.
210
211 =cut
212
213 sub clear_sys_metadata {
214   my ($self) = @_;
215
216   BSE::DB->run(bseClearArticleFileSysMetadata => $self->id, $self->meta_owner_type);
217 }
218
219 =item delete_meta_by_name
220
221 Remove a single piece of metadata from the object.
222
223 Restricted.
224
225 =cut
226
227 sub delete_meta_by_name {
228   my ($self, $name) = @_;
229
230 print STDERR "Delete ", $self->id, ",", $name, ",", $self->meta_owner_type, ")\n";
231   BSE::DB->run(bseDeleteArticleFileMetaByName => $self->id, $name, $self->meta_owner_type);
232 }
233
234 =item add_meta
235
236 Add metadata to the object.
237
238 Restricted.
239
240 =cut
241
242 sub add_meta {
243   my ($self, %opts) = @_;
244
245   my $value_text = delete $opts{value_text};
246   if ($value_text) {
247     utf8::encode($value_text);
248     $opts{value} = $value_text;
249   }
250
251   require BSE::TB::Metadata;
252   return BSE::TB::Metadata->make
253       (
254        file_id => $self->id,
255        owner_type => $self->meta_owner_type,
256        %opts,
257       );
258 }
259
260 sub restricted_method {
261   my ($self, $name) = @_;
262
263   return $name =~ /^(?:clear_|delete_|add_)/;
264 }
265
266 1;
267
268 =back
269
270 =cut