more metadata generalization and modification
[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
4029e8ab 7our $VERSION = "1.012";
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
218sub metafields {
219 my ($self, $cfg) = @_;
220
4029e8ab
TC
221 $cfg ||= BSE::Cfg->single;
222
36e373a9
TC
223 my %metanames = map { $_ => 1 } $self->metanames;
224
4029e8ab
TC
225 require BSE::FileMetaMeta;
226 my @fields = grep $metanames{$_->name} || $_->cond($self), BSE::FileMetaMeta->all_metametadata($cfg);
36e373a9
TC
227
228 my $handler = $self->handler($cfg);
229
230 my @handler_fields = map BSE::FileMetaMeta->new(%$_, ro => 1, cfg => $cfg), $handler->metametadata;
231
232 return ( @fields, @handler_fields );
233}
234
7c6f563b 235sub user_orders_for {
590bd52e
TC
236 my ($self, $user) = @_;
237
7c6f563b
TC
238 require BSE::TB::Orders;
239 return BSE::TB::Orders->getSpecial(fileOrdersByUser => $self->id, $user->id);
240}
241
242sub downloadable_by {
243 my ($self, $user, $error) = @_;
244
590bd52e
TC
245 $self->forSale
246 or return 1;
247
7c6f563b
TC
248 unless ($user) {
249 $$error = 'nouser';
250 return;
251 }
252
253 my @orders = $self->user_orders_for($user);
254 unless (@orders) {
255 $$error = 'noorder';
256 return;
257 }
258
259 if (BSE::TB::ArticleFiles->downloads_must_be_paid) {
260 @orders = grep $_->paidFor, @orders;
261 unless (@orders) {
262 $$error = 'unpaid';
263 return;
264 }
265 }
266
267 if (BSE::TB::ArticleFiles->downloads_must_be_filled) {
268 @orders = grep $_->filled, @orders;
269 unless (@orders) {
270 $$error = 'unfilled';
271 return;
272 }
273 }
590bd52e 274
7c6f563b 275 return 1;
590bd52e
TC
276}
277
bd903bc5
TC
278sub update {
279 my ($self, %opts) = @_;
280
281 my $actor = $opts{_actor}
282 or confess "Missing _actor parameter";
283
284 my $warnings = $opts{_warnings}
285 or confess "Missing _warnings parameter";
286
287 my $cfg = BSE::Cfg->single;
288 my $file_dir = BSE::TB::ArticleFiles->download_path($cfg);
289 my $old_storage = $self->storage;
290 my $delete_file;
291 if ($opts{filename} || $opts{file}) {
292 my $src_filename = delete $opts{filename};
293 my $filename;
294 if ($src_filename) {
295 if ($src_filename =~ /^\Q$file_dir\E/) {
296 # created in the right place, use it
297 $filename = $src_filename;
298 }
299 else {
300 open my $in_fh, "<", $src_filename
301 or die "Cannot open $src_filename: $!\n";
302 binmode $in_fh;
303
304 require DevHelp::FileUpload;
305 my $msg;
306 ($filename) = DevHelp::FileUpload->
3f58d535 307 make_fh_copy($in_fh, $file_dir, $opts{displayName}, \$msg)
bd903bc5
TC
308 or die "$msg\n";
309 }
310 }
311 elsif ($opts{file}) {
312 my $file = delete $opts{file};
313 require DevHelp::FileUpload;
314 my $msg;
315 ($filename) = DevHelp::FileUpload->
316 make_fh_copy($file, $file_dir, $opts{displayName}, \$msg)
317 or die "$msg\n";
318 }
319
320 my $fullpath = $file_dir . '/' . $filename;
321 $self->set_filename($filename);
322 $self->set_sizeInBytes(-s $fullpath);
323 $self->setDisplayName($opts{displayName});
324
325 unless ($opts{contentType}) {
326 require BSE::Util::ContentType;
327 $self->set_contentType(BSE::Util::ContentType::content_type($cfg, $opts{displayName}));
328 }
329
330 $self->set_handler($cfg);
331 }
332
333 my $type = delete $opts{contentType};
334 if (defined $type) {
335 $self->set_contentType($type);
336 }
337
3f58d535
TC
338 for my $field (qw(displayName description forSale download requireUser notes hide_from_list category)) {
339 my $value = delete $opts{$field};
340 if (defined $value) {
341 my $method = "set_$field";
342 $self->$method($value);
343 }
344 }
345
bd903bc5 346 my $name = $opts{name};
bd903bc5
TC
347 if (defined $name && $name =~ /\S/) {
348 $name =~ /^\w+$/
349 or die "name must be a single word\n";
350 my ($other) = BSE::TB::ArticleFiles->getBy(articleId => $self->id,
351 name => $name);
352 $other && $other->id != $self->id
353 and die "Duplicate file name (identifier)\n";
354
355 $self->set_name($name);
356 }
357
358 $self->save;
359
360 my $mgr = BSE::TB::ArticleFiles->file_manager($cfg);
361 if ($delete_file) {
362 if ($old_storage ne "local") {
363 $mgr->unstore($delete_file);
364 }
365 unlink "$file_dir/$delete_file";
366
367 $old_storage = "local";
368 }
369
370 my $storage = delete $opts{storage} || '';
371
372 my $new_storage;
373 eval {
374 $new_storage =
375 $mgr->select_store($self->filename, $storage, $self);
376 if ($old_storage ne $new_storage) {
377 # handles both new images (which sets storage to local) and changing
378 # the storage for old images
379 my $src = $mgr->store($self->filename, $new_storage, $self);
380 $self->set_src($src);
381 $self->set_storage($new_storage);
382 $self->save;
383 }
384 1;
385 } or do {
386 my $msg = $@;
387 chomp $msg;
388 require BSE::TB::AuditLog;
389 BSE::TB::AuditLog->log
390 (
391 component => "admin:edit:saveimage",
3ea6f4c8 392 level => "warning",
bd903bc5
TC
393 object => $self,
394 actor => $actor,
395 msg => "Error saving file to storage $new_storage: $msg",
396 );
397 push @$warnings, "msg:bse/admin/edit/file/save/savetostore:$msg";
398 };
399
400 if ($self->storage ne $old_storage && $old_storage ne "local") {
401 eval {
402 $mgr->unstore($self->filename, $old_storage);
403 1;
404 } or do {
405 my $msg = $@;
406 chomp $msg;
407 require BSE::TB::AuditLog;
408 BSE::TB::AuditLog->log
409 (
410 component => "admin:edit:savefile",
3ea6f4c8 411 level => "warning",
bd903bc5
TC
412 object => $self,
413 actor => $actor,
414 msg => "Error saving file to storage $new_storage: $msg",
415 );
416 push @$warnings, "msg:bse/admin/edit/file/save/delfromstore:$msg";
417 };
418 }
f5b7b326 419}
bd903bc5 420
f5b7b326
TC
421sub meta_owner_type {
422 'bse_file';
bd903bc5
TC
423}
424
4029e8ab
TC
425sub meta_meta_cfg_section {
426 "global file metadata";
427}
428
429sub meta_meta_cfg_prefix {
430 "file metadata";
431}
432
433sub restricted_method {
434 my ($self, $name) = @_;
435
436 return $self->Squirrel::Row::restricted_method($name)
437 || $self->BSE::MetaOwnerBase::restricted_method($name);
438}
439
6430ee52 4401;