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;