make metadata more general
[bse.git] / site / cgi-bin / modules / BSE / TB / ArticleFile.pm
CommitLineData
6430ee52
TC
1package BSE::TB::ArticleFile;
2use strict;
3# represents a file associated with an article from the database
f5b7b326 4use base qw(Squirrel::Row BSE::MetaOwnerBase);
6430ee52
TC
5use Carp 'confess';
6
e0ed81d7 7our $VERSION = "1.011";
cb7fd78d 8
6430ee52
TC
9sub columns {
10 return qw/id articleId displayName filename sizeInBytes description
11 contentType displayOrder forSale download whenUploaded
12 requireUser notes name hide_from_list storage src category
13 file_handler/;
14}
15
7646d96e
TC
16sub table {
17 "article_files";
18}
19
20sub defaults {
21 require BSE::Util::SQL;
22 return
23 (
24 notes => '',
25 description => '',
26 name => '',
27 whenUploaded => BSE::Util::SQL::now_datetime(),
28 displayOrder => time,
29 src => '',
30 file_handler => '',
31 forSale => 0,
32 download => 0,
33 requireUser => 0,
34 hide_from_list => 0,
35 category => '',
36 storage => 'local',
37 );
38}
39
6430ee52
TC
40sub full_filename {
41 my ($self, $cfg) = @_;
42
bef6fc2c
TC
43 $cfg ||= BSE::Cfg->single;
44
6430ee52
TC
45 my $downloadPath = BSE::TB::ArticleFiles->download_path($cfg);
46 return $downloadPath . "/" . $self->{filename};
47}
48
bef6fc2c
TC
49sub file_exists {
50 my ($self, $cfg) = @_;
51
52 return -f $self->full_filename($cfg);
53}
54
6430ee52
TC
55sub remove {
56 my ($self, $cfg) = @_;
57
58 $self->clear_metadata;
59
60 $cfg or confess "No \$cfg supplied to ",ref $self,"->remove()";
61
62 my $filename = $self->full_filename($cfg);
63 my $debug_del = $cfg->entryBool('debug', 'file_unlink', 0);
64 if ($debug_del) {
65 unlink $filename
66 or print STDERR "Error deleting $filename: $!\n";
67 }
68 else {
69 unlink $filename;
70 }
71
72 $self->SUPER::remove();
73}
74
75sub article {
76 my $self = shift;
e0ed81d7 77 require BSE::TB::Articles;
6430ee52 78
e0ed81d7 79 return BSE::TB::Articles->getByPkey($self->{articleId});
6430ee52
TC
80}
81
82sub url {
7646d96e
TC
83 my ($file, $cfg) = @_;
84
85 # return "/cgi-bin/user.pl/download_file/$file->{id}";
6430ee52 86
590bd52e 87 $cfg ||= BSE::Cfg->single;
7646d96e
TC
88
89 if ($file->storage eq "local"
90 || $file->forSale
91 || $file->requireUser
92 || $cfg->entryBool("downloads", "require_logon", 0)
93 || $cfg->entry("downloads", "always_redirect", 0)) {
94 return "/cgi-bin/user.pl/download_file/$file->{id}";
95 }
96 else {
97 return $file->src;
98 }
6430ee52
TC
99}
100
101sub handler {
102 my ($self, $cfg) = @_;
103
104 return BSE::TB::ArticleFiles->handler($self->file_handler, $cfg);
105}
106
6430ee52
TC
107sub set_handler {
108 my ($self, $cfg) = @_;
109
110 my %errors; # save for later setting into the metadata
111
112 for my $handler_entry (BSE::TB::ArticleFiles->file_handlers($cfg)) {
113 my ($key, $handler) = @$handler_entry;
114 my $success = eval {
c840f7f9 115 $self->clear_sys_metadata;
6430ee52
TC
116 $handler->process_file($self);
117 1;
118 };
119 if ($success) {
120 # set errors from handlers that failed
121 for my $key (keys %errors) {
c840f7f9
TC
122 $self->add_meta(name => "${key}_error",
123 value => $errors{$key},
124 appdata => 0);
6430ee52
TC
125 }
126 $self->set_file_handler($key);
127
128 return;
129 }
130 else {
131 $errors{$key} = $@;
132 chomp $errors{$key};
133 }
134 }
135
136 # we should never get here
137 $self->set_file_handler("");
138 print STDERR "** Ran off the end of ArticleFile->set_handler()\n";
139 return;
140}
141
6430ee52
TC
142sub inline {
143 my ($file, %opts) = @_;
144
145 my $cfg = delete $opts{cfg}
146 or confess "Missing cfg parameter";
147
148 my $field = delete $opts{field};
149 defined $field or $field = "";
150
151 if ($field && exists $file->{$field}) {
37b7b355
TC
152 require BSE::Util::HTML;
153 return BSE::Util::HTML::escape_html($file->{$field});
6430ee52
TC
154 }
155 elsif ($field =~ /^meta\.(\w+)$/) {
156 my $name = $1;
157 my $meta = $file->meta_by_name($name)
158 or return "";
159 $meta->content_type eq "text/plain"
160 or return "* metadata $name isn't text *";
161
3f9c8a96
TC
162 require BSE::Util::HTML;
163 return BSE::Util::HTML::escape_html($meta->value);
6430ee52 164 }
32ed6995 165 elsif ($field eq "link" || $field eq "url") {
6430ee52 166 my $url = "/cgi-bin/user.pl?download_file=1&file=$file->{id}";
3f9c8a96
TC
167 require BSE::Util::HTML;
168 my $eurl = BSE::Util::HTML::escape_html($url);
6430ee52
TC
169 if ($field eq 'url') {
170 return $eurl;
171 }
172 my $class = $file->{download} ? "file_download" : "file_inline";
37b7b355 173 my $html = qq!<a class="$class" href="$eurl">! . BSE::Util::HTML::escape_html($file->{displayName}) . '</a>';
6430ee52
TC
174 return $html;
175 }
176 else {
177 my $handler = $file->handler($cfg);
178 return $handler->inline($file, $field);
179 }
180
181}
182
34454372
TC
183# returns file type specific metadata
184sub metacontent {
185 my ($file, %opts) = @_;
186
187 my $cfg = delete $opts{cfg}
188 or confess "Missing cfg parameter";
189
190 my $name = delete $opts{name}
191 or confess "Missing name parameter";
192
193 my $handler = $file->handler($cfg);
194 return $handler->metacontent($file, $name);
195}
196
7646d96e
TC
197sub apply_storage {
198 my ($self, $cfg, $mgr, $storage) = @_;
199
200 defined $storage or $storage = 'local';
201
202 if ($storage ne $self->storage) {
203 if ($self->storage ne "local") {
204 $mgr->unstore($self->filename, $self->storage);
205 $self->set_storage("local");
206 }
207 if ($storage ne "local") {
208 my $src = $mgr->store($self->filename, $storage, $self);
209 if ($src) {
210 $self->{src} = $src;
211 $self->{storage} = $storage;
212 }
213 }
214 $self->save;
215 }
216}
217
36e373a9
TC
218=item metanames
219
220returns the names of each metadatum defined for the file.
221
222=cut
223
224sub metanames {
225 my ($self) = @_;
226
227 require BSE::TB::ArticleFileMetas;
95e517da 228 return BSE::TB::ArticleFileMetas->getColumnBy
36e373a9 229 (
95e517da
TC
230 "name",
231 [ file_id => $self->id ],
36e373a9
TC
232 );
233}
234
235=item metainfo
236
237Returns all but the value for metadata defined for the file.
238
239=cut
240
241sub metainfo {
242 my ($self) = @_;
243
244 require BSE::TB::ArticleFileMetas;
245 my @cols = grep $_ ne "value", BSE::TB::ArticleFileMeta->columns;
246 return BSE::TB::ArticleFileMetas->getColumnsBy
247 (
248 \@cols,
95e517da 249 [ file_id => $self->id ],
36e373a9
TC
250 );
251}
252
253sub metafields {
254 my ($self, $cfg) = @_;
255
256 my %metanames = map { $_ => 1 } $self->metanames;
257
258 my @fields = grep $metanames{$_->name} || $_->cond($self), BSE::TB::ArticleFiles->all_metametadata($cfg);
259
260 my $handler = $self->handler($cfg);
261
262 my @handler_fields = map BSE::FileMetaMeta->new(%$_, ro => 1, cfg => $cfg), $handler->metametadata;
263
264 return ( @fields, @handler_fields );
265}
266
7c6f563b 267sub user_orders_for {
590bd52e
TC
268 my ($self, $user) = @_;
269
7c6f563b
TC
270 require BSE::TB::Orders;
271 return BSE::TB::Orders->getSpecial(fileOrdersByUser => $self->id, $user->id);
272}
273
274sub downloadable_by {
275 my ($self, $user, $error) = @_;
276
590bd52e
TC
277 $self->forSale
278 or return 1;
279
7c6f563b
TC
280 unless ($user) {
281 $$error = 'nouser';
282 return;
283 }
284
285 my @orders = $self->user_orders_for($user);
286 unless (@orders) {
287 $$error = 'noorder';
288 return;
289 }
290
291 if (BSE::TB::ArticleFiles->downloads_must_be_paid) {
292 @orders = grep $_->paidFor, @orders;
293 unless (@orders) {
294 $$error = 'unpaid';
295 return;
296 }
297 }
298
299 if (BSE::TB::ArticleFiles->downloads_must_be_filled) {
300 @orders = grep $_->filled, @orders;
301 unless (@orders) {
302 $$error = 'unfilled';
303 return;
304 }
305 }
590bd52e 306
7c6f563b 307 return 1;
590bd52e
TC
308}
309
bd903bc5
TC
310sub update {
311 my ($self, %opts) = @_;
312
313 my $actor = $opts{_actor}
314 or confess "Missing _actor parameter";
315
316 my $warnings = $opts{_warnings}
317 or confess "Missing _warnings parameter";
318
319 my $cfg = BSE::Cfg->single;
320 my $file_dir = BSE::TB::ArticleFiles->download_path($cfg);
321 my $old_storage = $self->storage;
322 my $delete_file;
323 if ($opts{filename} || $opts{file}) {
324 my $src_filename = delete $opts{filename};
325 my $filename;
326 if ($src_filename) {
327 if ($src_filename =~ /^\Q$file_dir\E/) {
328 # created in the right place, use it
329 $filename = $src_filename;
330 }
331 else {
332 open my $in_fh, "<", $src_filename
333 or die "Cannot open $src_filename: $!\n";
334 binmode $in_fh;
335
336 require DevHelp::FileUpload;
337 my $msg;
338 ($filename) = DevHelp::FileUpload->
3f58d535 339 make_fh_copy($in_fh, $file_dir, $opts{displayName}, \$msg)
bd903bc5
TC
340 or die "$msg\n";
341 }
342 }
343 elsif ($opts{file}) {
344 my $file = delete $opts{file};
345 require DevHelp::FileUpload;
346 my $msg;
347 ($filename) = DevHelp::FileUpload->
348 make_fh_copy($file, $file_dir, $opts{displayName}, \$msg)
349 or die "$msg\n";
350 }
351
352 my $fullpath = $file_dir . '/' . $filename;
353 $self->set_filename($filename);
354 $self->set_sizeInBytes(-s $fullpath);
355 $self->setDisplayName($opts{displayName});
356
357 unless ($opts{contentType}) {
358 require BSE::Util::ContentType;
359 $self->set_contentType(BSE::Util::ContentType::content_type($cfg, $opts{displayName}));
360 }
361
362 $self->set_handler($cfg);
363 }
364
365 my $type = delete $opts{contentType};
366 if (defined $type) {
367 $self->set_contentType($type);
368 }
369
3f58d535
TC
370 for my $field (qw(displayName description forSale download requireUser notes hide_from_list category)) {
371 my $value = delete $opts{$field};
372 if (defined $value) {
373 my $method = "set_$field";
374 $self->$method($value);
375 }
376 }
377
bd903bc5 378 my $name = $opts{name};
bd903bc5
TC
379 if (defined $name && $name =~ /\S/) {
380 $name =~ /^\w+$/
381 or die "name must be a single word\n";
382 my ($other) = BSE::TB::ArticleFiles->getBy(articleId => $self->id,
383 name => $name);
384 $other && $other->id != $self->id
385 and die "Duplicate file name (identifier)\n";
386
387 $self->set_name($name);
388 }
389
390 $self->save;
391
392 my $mgr = BSE::TB::ArticleFiles->file_manager($cfg);
393 if ($delete_file) {
394 if ($old_storage ne "local") {
395 $mgr->unstore($delete_file);
396 }
397 unlink "$file_dir/$delete_file";
398
399 $old_storage = "local";
400 }
401
402 my $storage = delete $opts{storage} || '';
403
404 my $new_storage;
405 eval {
406 $new_storage =
407 $mgr->select_store($self->filename, $storage, $self);
408 if ($old_storage ne $new_storage) {
409 # handles both new images (which sets storage to local) and changing
410 # the storage for old images
411 my $src = $mgr->store($self->filename, $new_storage, $self);
412 $self->set_src($src);
413 $self->set_storage($new_storage);
414 $self->save;
415 }
416 1;
417 } or do {
418 my $msg = $@;
419 chomp $msg;
420 require BSE::TB::AuditLog;
421 BSE::TB::AuditLog->log
422 (
423 component => "admin:edit:saveimage",
3ea6f4c8 424 level => "warning",
bd903bc5
TC
425 object => $self,
426 actor => $actor,
427 msg => "Error saving file to storage $new_storage: $msg",
428 );
429 push @$warnings, "msg:bse/admin/edit/file/save/savetostore:$msg";
430 };
431
432 if ($self->storage ne $old_storage && $old_storage ne "local") {
433 eval {
434 $mgr->unstore($self->filename, $old_storage);
435 1;
436 } or do {
437 my $msg = $@;
438 chomp $msg;
439 require BSE::TB::AuditLog;
440 BSE::TB::AuditLog->log
441 (
442 component => "admin:edit:savefile",
3ea6f4c8 443 level => "warning",
bd903bc5
TC
444 object => $self,
445 actor => $actor,
446 msg => "Error saving file to storage $new_storage: $msg",
447 );
448 push @$warnings, "msg:bse/admin/edit/file/save/delfromstore:$msg";
449 };
450 }
f5b7b326 451}
bd903bc5 452
f5b7b326
TC
453sub meta_owner_type {
454 'bse_file';
bd903bc5
TC
455}
456
6430ee52 4571;