use new style field macros for the file edit page
[bse.git] / site / cgi-bin / modules / BSE / TB / ArticleFile.pm
1 package BSE::TB::ArticleFile;
2 use strict;
3 # represents a file associated with an article from the database
4 use base qw(Squirrel::Row BSE::MetaOwnerBase);
5 use Carp 'confess';
6
7 our $VERSION = "1.013";
8
9 sub 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
16 sub table {
17   "article_files";
18 }
19
20 sub 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
40 sub 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
116 sub full_filename {
117   my ($self, $cfg) = @_;
118
119   $cfg ||= BSE::Cfg->single;
120
121   my $downloadPath = BSE::TB::ArticleFiles->download_path($cfg);
122   return $downloadPath . "/" . $self->{filename};
123 }
124
125 sub file_exists {
126   my ($self, $cfg) = @_;
127
128   return -f $self->full_filename($cfg);
129 }
130
131 sub 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
151 sub article {
152   my $self = shift;
153   require BSE::TB::Articles;
154
155   return BSE::TB::Articles->getByPkey($self->{articleId});
156 }
157
158 sub url {
159   my ($file, $cfg) = @_;
160
161  #   return "/cgi-bin/user.pl/download_file/$file->{id}";
162
163   $cfg ||= BSE::Cfg->single;
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   }
175 }
176
177 sub handler {
178   my ($self, $cfg) = @_;
179
180   return BSE::TB::ArticleFiles->handler($self->file_handler, $cfg);
181 }
182
183 sub 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 {
191       $self->clear_sys_metadata;
192       $handler->process_file($self);
193       1;
194     };
195     if ($success) {
196       # set errors from handlers that failed
197       for my $key (keys %errors) {
198         $self->add_meta(name => "${key}_error",
199                         value => $errors{$key},
200                         appdata => 0);
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
218 sub 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}) {
228     require BSE::Util::HTML;
229     return BSE::Util::HTML::escape_html($file->{$field});
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
238     require BSE::Util::HTML;
239     return BSE::Util::HTML::escape_html($meta->value);
240   }
241   elsif ($field eq "link" || $field eq "url") {
242     my $url = "/cgi-bin/user.pl?download_file=1&file=$file->{id}";
243     require BSE::Util::HTML;
244     my $eurl = BSE::Util::HTML::escape_html($url);
245     if ($field eq 'url') {
246       return $eurl;
247     }
248     my $class = $file->{download} ? "file_download" : "file_inline";
249     my $html = qq!<a class="$class" href="$eurl">! . BSE::Util::HTML::escape_html($file->{displayName}) . '</a>';
250     return $html;
251   }
252   else {
253     my $handler = $file->handler($cfg);
254     return $handler->inline($file, $field);
255   }
256
257 }
258
259 # returns file type specific metadata
260 sub 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
273 sub 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
294 sub metafields {
295   my ($self, $cfg) = @_;
296
297   $cfg ||= BSE::Cfg->single;
298
299   my %metanames = map { $_ => 1 } $self->metanames;
300
301   require BSE::FileMetaMeta;
302   my @fields = grep $metanames{$_->name} || $_->cond($self), BSE::FileMetaMeta->all_metametadata($cfg);
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
311 sub user_orders_for {
312   my ($self, $user) = @_;
313
314   require BSE::TB::Orders;
315   return BSE::TB::Orders->getSpecial(fileOrdersByUser => $self->id, $user->id);
316 }
317
318 sub downloadable_by {
319   my ($self, $user, $error) = @_;
320
321   $self->forSale
322     or return 1;
323
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   }
350
351   return 1;
352 }
353
354 sub 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->
383           make_fh_copy($in_fh, $file_dir, $opts{displayName}, \$msg)
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
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
422   my $name = $opts{name};
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",
468        level => "warning",
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",
487          level => "warning",
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   }
495 }
496
497 sub meta_owner_type {
498   'bse_file';
499 }
500
501 sub meta_meta_cfg_section {
502   "global file metadata";
503 }
504
505 sub meta_meta_cfg_prefix {
506   "file metadata";
507 }
508
509 sub restricted_method {
510   my ($self, $name) = @_;
511
512   return $self->Squirrel::Row::restricted_method($name)
513     || $self->BSE::MetaOwnerBase::restricted_method($name);
514 }
515
516 1;