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