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.011";
   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 full_filename {
  41   my ($self, $cfg) = @_;
  42
  43   $cfg ||= BSE::Cfg->single;
  44
  45   my $downloadPath = BSE::TB::ArticleFiles->download_path($cfg);
  46   return $downloadPath . "/" . $self->{filename};
  47 }
  48
  49 sub file_exists {
  50   my ($self, $cfg) = @_;
  51
  52   return -f $self->full_filename($cfg);
  53 }
  54
  55 sub 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
  75 sub article {
  76   my $self = shift;
  77   require BSE::TB::Articles;
  78
  79   return BSE::TB::Articles->getByPkey($self->{articleId});
  80 }
  81
  82 sub url {
  83   my ($file, $cfg) = @_;
  84
  85  #   return "/cgi-bin/user.pl/download_file/$file->{id}";
  86
  87   $cfg ||= BSE::Cfg->single;
  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   }
  99 }
 100
 101 sub handler {
 102   my ($self, $cfg) = @_;
 103
 104   return BSE::TB::ArticleFiles->handler($self->file_handler, $cfg);
 105 }
 106
 107 sub 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 {
 115       $self->clear_sys_metadata;
 116       $handler->process_file($self);
 117       1;
 118     };
 119     if ($success) {
 120       # set errors from handlers that failed
 121       for my $key (keys %errors) {
 122         $self->add_meta(name => "${key}_error",
 123                         value => $errors{$key},
 124                         appdata => 0);
 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
 142 sub 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}) {
 152     require BSE::Util::HTML;
 153     return BSE::Util::HTML::escape_html($file->{$field});
 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
 162     require BSE::Util::HTML;
 163     return BSE::Util::HTML::escape_html($meta->value);
 164   }
 165   elsif ($field eq "link" || $field eq "url") {
 166     my $url = "/cgi-bin/user.pl?download_file=1&file=$file->{id}";
 167     require BSE::Util::HTML;
 168     my $eurl = BSE::Util::HTML::escape_html($url);
 169     if ($field eq 'url') {
 170       return $eurl;
 171     }
 172     my $class = $file->{download} ? "file_download" : "file_inline";
 173     my $html = qq!<a class="$class" href="$eurl">! . BSE::Util::HTML::escape_html($file->{displayName}) . '</a>';
 174     return $html;
 175   }
 176   else {
 177     my $handler = $file->handler($cfg);
 178     return $handler->inline($file, $field);
 179   }
 180
 181 }
 182
 183 # returns file type specific metadata
 184 sub 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
 197 sub 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
 218 =item metanames
 219
 220 returns the names of each metadatum defined for the file.
 221
 222 =cut
 223
 224 sub metanames {
 225   my ($self) = @_;
 226
 227   require BSE::TB::ArticleFileMetas;
 228   return BSE::TB::ArticleFileMetas->getColumnBy
 229     (
 230      "name",
 231      [ file_id => $self->id ],
 232     );
 233 }
 234
 235 =item metainfo
 236
 237 Returns all but the value for metadata defined for the file.
 238
 239 =cut
 240
 241 sub metainfo {
 242   my ($self) = @_;
 243
 244   require BSE::TB::ArticleFileMetas;
 245   my @cols = grep $_ ne "value", BSE::TB::ArticleFileMeta->columns;
 246   return BSE::TB::ArticleFileMetas->getColumnsBy
 247     (
 248      \@cols,
 249      [ file_id => $self->id ],
 250     );
 251 }
 252
 253 sub metafields {
 254   my ($self, $cfg) = @_;
 255
 256   my %metanames = map { $_ => 1 } $self->metanames;
 257
 258   my @fields = grep $metanames{$_->name} || $_->cond($self), BSE::TB::ArticleFiles->all_metametadata($cfg);
 259
 260   my $handler = $self->handler($cfg);
 261
 262   my @handler_fields = map BSE::FileMetaMeta->new(%$_, ro => 1, cfg => $cfg), $handler->metametadata;
 263
 264   return ( @fields, @handler_fields );
 265 }
 266
 267 sub user_orders_for {
 268   my ($self, $user) = @_;
 269
 270   require BSE::TB::Orders;
 271   return BSE::TB::Orders->getSpecial(fileOrdersByUser => $self->id, $user->id);
 272 }
 273
 274 sub downloadable_by {
 275   my ($self, $user, $error) = @_;
 276
 277   $self->forSale
 278     or return 1;
 279
 280   unless ($user) {
 281     $$error = 'nouser';
 282     return;
 283   }
 284
 285   my @orders = $self->user_orders_for($user);
 286   unless (@orders) {
 287     $$error = 'noorder';
 288     return;
 289   }
 290
 291   if (BSE::TB::ArticleFiles->downloads_must_be_paid) {
 292     @orders = grep $_->paidFor, @orders;
 293     unless (@orders) {
 294       $$error = 'unpaid';
 295       return;
 296     }
 297   }
 298
 299   if (BSE::TB::ArticleFiles->downloads_must_be_filled) {
 300     @orders = grep $_->filled, @orders;
 301     unless (@orders) {
 302       $$error = 'unfilled';
 303       return;
 304     }
 305   }
 306
 307   return 1;
 308 }
 309
 310 sub update {
 311   my ($self, %opts) = @_;
 312
 313   my $actor = $opts{_actor}
 314     or confess "Missing _actor parameter";
 315
 316   my $warnings = $opts{_warnings}
 317     or confess "Missing _warnings parameter";
 318
 319   my $cfg = BSE::Cfg->single;
 320   my $file_dir = BSE::TB::ArticleFiles->download_path($cfg);
 321   my $old_storage = $self->storage;
 322   my $delete_file;
 323   if ($opts{filename} || $opts{file}) {
 324     my $src_filename = delete $opts{filename};
 325     my $filename;
 326     if ($src_filename) {
 327       if ($src_filename =~ /^\Q$file_dir\E/) {
 328         # created in the right place, use it
 329         $filename = $src_filename;
 330       }
 331       else {
 332         open my $in_fh, "<", $src_filename
 333           or die "Cannot open $src_filename: $!\n";
 334         binmode $in_fh;
 335
 336         require DevHelp::FileUpload;
 337         my $msg;
 338         ($filename) = DevHelp::FileUpload->
 339           make_fh_copy($in_fh, $file_dir, $opts{displayName}, \$msg)
 340             or die "$msg\n";
 341       }
 342     }
 343     elsif ($opts{file}) {
 344       my $file = delete $opts{file};
 345       require DevHelp::FileUpload;
 346       my $msg;
 347       ($filename) = DevHelp::FileUpload->
 348         make_fh_copy($file, $file_dir, $opts{displayName}, \$msg)
 349           or die "$msg\n";
 350     }
 351
 352     my $fullpath = $file_dir . '/' . $filename;
 353     $self->set_filename($filename);
 354     $self->set_sizeInBytes(-s $fullpath);
 355     $self->setDisplayName($opts{displayName});
 356
 357     unless ($opts{contentType}) {
 358       require BSE::Util::ContentType;
 359       $self->set_contentType(BSE::Util::ContentType::content_type($cfg, $opts{displayName}));
 360     }
 361
 362     $self->set_handler($cfg);
 363   }
 364
 365   my $type = delete $opts{contentType};
 366   if (defined $type) {
 367     $self->set_contentType($type);
 368   }
 369
 370   for my $field (qw(displayName description forSale download requireUser notes hide_from_list category)) {
 371     my $value = delete $opts{$field};
 372     if (defined $value) {
 373       my $method = "set_$field";
 374       $self->$method($value);
 375     }
 376   }
 377
 378   my $name = $opts{name};
 379   if (defined $name && $name =~ /\S/) {
 380     $name =~ /^\w+$/
 381       or die "name must be a single word\n";
 382     my ($other) = BSE::TB::ArticleFiles->getBy(articleId => $self->id,
 383                                                name => $name);
 384     $other && $other->id != $self->id
 385       and die "Duplicate file name (identifier)\n";
 386
 387     $self->set_name($name);
 388   }
 389
 390   $self->save;
 391
 392   my $mgr = BSE::TB::ArticleFiles->file_manager($cfg);
 393   if ($delete_file) {
 394     if ($old_storage ne "local") {
 395       $mgr->unstore($delete_file);
 396     }
 397     unlink "$file_dir/$delete_file";
 398
 399     $old_storage = "local";
 400   }
 401
 402   my $storage = delete $opts{storage} || '';
 403
 404   my $new_storage;
 405   eval {
 406     $new_storage =
 407       $mgr->select_store($self->filename, $storage, $self);
 408     if ($old_storage ne $new_storage) {
 409       # handles both new images (which sets storage to local) and changing
 410       # the storage for old images
 411       my $src = $mgr->store($self->filename, $new_storage, $self);
 412       $self->set_src($src);
 413       $self->set_storage($new_storage);
 414       $self->save;
 415     }
 416     1;
 417   } or do {
 418     my $msg = $@;
 419     chomp $msg;
 420     require BSE::TB::AuditLog;
 421     BSE::TB::AuditLog->log
 422       (
 423        component => "admin:edit:saveimage",
 424        level => "warning",
 425        object => $self,
 426        actor => $actor,
 427        msg => "Error saving file to storage $new_storage: $msg",
 428       );
 429     push @$warnings, "msg:bse/admin/edit/file/save/savetostore:$msg";
 430   };
 431
 432   if ($self->storage ne $old_storage && $old_storage ne "local") {
 433     eval {
 434       $mgr->unstore($self->filename, $old_storage);
 435       1;
 436     } or do {
 437       my $msg = $@;
 438       chomp $msg;
 439       require BSE::TB::AuditLog;
 440       BSE::TB::AuditLog->log
 441         (
 442          component => "admin:edit:savefile",
 443          level => "warning",
 444          object => $self,
 445          actor => $actor,
 446          msg => "Error saving file to storage $new_storage: $msg",
 447         );
 448       push @$warnings, "msg:bse/admin/edit/file/save/delfromstore:$msg";
 449     };
 450   }
 451 }
 452
 453 sub meta_owner_type {
 454   'bse_file';
 455 }
 456
 457 1;