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