site/cgi-bin/modules/BSE/TB/Image.pm

   1 package BSE::TB::Image;
   2 use strict;
   3 # represents an image from the database
   4 use Squirrel::Row;
   5 use BSE::ThumbCommon;
   6 use BSE::TB::TagOwner;
   7 use vars qw/@ISA/;
   8 @ISA = qw/Squirrel::Row BSE::ThumbCommon BSE::TB::TagOwner/;
   9 use Carp qw(confess);
  10
  11 our $VERSION = "1.011";
  12
  13 =head1 NAME
  14
  15 BSE::TB::Image - images attached to an article or a global image.
  16
  17 =head1 SYNOPSIS
  18
  19   my @images = $article->images;
  20
  21 =head1 DESCRIPTION
  22
  23 X<images>This class represents an image attached to an article, or a
  24 global image.
  25
  26 =head1 METHODS
  27
  28 =over
  29
  30 =item id
  31
  32 Unique id for this image.
  33
  34 =item articleId
  35
  36 article this image belongs to.  C<-1> for global images.
  37
  38 =item image
  39
  40 image filename as stored in the images directory.  See C</image_url>
  41 to get a URL to the image.
  42
  43 =item alt
  44
  45 alternate text for the image
  46
  47 =item width
  48
  49 =item height
  50
  51 X<image, width>X<image, height>width and height of the
  52 image in pixels.
  53
  54 =item url
  55
  56 url to link to when the image is inlined.
  57
  58 =item displayOrder
  59
  60 sort key for ordering images belonging to an article (or within the
  61 global image collection.)
  62
  63 =item name
  64
  65 unique name for the image within the images belonging to an article
  66 (or withing the global image collection.)  Can be an empty string.
  67
  68 =item storage
  69
  70 the external storage used for the image, or C<local> for locally
  71 stored images.
  72
  73 =item src
  74
  75 for externally stored images, the URL to the image.  Use
  76 C</image_url()>.
  77
  78 =item ftype
  79
  80 the type of image, either C<img> for normal images, C<svg> for SVG
  81 images or C<flash> for flash files.
  82
  83 =cut
  84
  85 sub columns {
  86   return qw/id articleId image alt width height url displayOrder name
  87             storage src ftype/;
  88 }
  89
  90 sub table { "image" }
  91
  92 =item formatted(...)
  93
  94 Call the format() image handler object for this image.
  95
  96 Accepts the following parameters:
  97
  98 =over
  99
 100 =item *
 101
 102 C<align> - sets the align attribute.
 103
 104 =item *
 105
 106 C<extras> - extra C<img> tag attributes.
 107
 108 =back
 109
 110 Returns HTML.
 111
 112 =cut
 113
 114 sub formatted {
 115   my ($self, %opts) = @_;
 116
 117   my $cfg = delete $opts{cfg}
 118     or confess "Missing cfg parameter";
 119
 120   my $handler = $self->_handler_object($cfg);
 121
 122   return $handler->format
 123     (
 124      image => $self,
 125      %opts,
 126     );
 127 }
 128
 129 =item inline(...)
 130
 131 Inline the image, accepts the following parameters:
 132
 133 =over
 134
 135 =item *
 136
 137 C<align> - set class to C<< bse_image_I<align> >>.
 138
 139 =back
 140
 141 Returns HTML.
 142
 143 =cut
 144
 145 sub inline {
 146   my ($self, %opts) = @_;
 147
 148   my $cfg = delete $opts{cfg} || BSE::Cfg->single;
 149
 150   my $handler = $self->_handler_object($cfg);
 151
 152   return $handler->inline
 153     (
 154      image => $self,
 155      %opts,
 156     );
 157 }
 158
 159 =item popimage(...)
 160
 161 Call the popimage() image handler object for this image, displaying
 162 the image as a thumbnail that displays a larger version when clicked.
 163
 164 Parameters:
 165
 166 =over
 167
 168 =item *
 169
 170 C<class> - controls the section of the config file that popup
 171 parameters are taken from.
 172
 173 =item *
 174
 175 C<static> - true to use static URLs for the thumbnails.
 176
 177 =back
 178
 179 Returns HTML.
 180
 181 =cut
 182
 183 sub popimage {
 184   my ($im, %opts) = @_;
 185
 186   my $cfg = delete $opts{cfg}
 187     or confess "Missing cfg parameter";
 188
 189   my $handler = $im->_handler_object($cfg);
 190
 191   return $handler->popimage
 192     (
 193      image => $im,
 194      %opts,
 195     );
 196 }
 197
 198 =item image_url
 199
 200 Return the image's source URL.  This will be the storage URL if the
 201 image is C<storage> is not C<local>.
 202
 203 =cut
 204
 205 sub image_url {
 206   my ($im) = @_;
 207
 208   return $im->src || BSE::TB::Images->base_uri . $im->image;
 209 }
 210
 211 =item json_data
 212
 213 Returns the image data as a data structure suitable for conversion to
 214 JSON.
 215
 216 =cut
 217
 218 sub json_data {
 219   my ($self) = @_;
 220
 221   my $data = $self->data_only;
 222   $data->{url} = $self->image_url;
 223   $data->{tags} = [ $self->tags ];
 224
 225   return $data;
 226 }
 227
 228 =item dynamic_thumb_url(...)
 229
 230 Return a dynamic URL to a thumbnail of the image.
 231
 232 Requires one named parameter:
 233
 234 =over
 235
 236 =item *
 237
 238 C<geo> - the thumbnail geometry to use.
 239
 240 =back
 241
 242 =cut
 243
 244 sub dynamic_thumb_url {
 245   my ($self, %opts) = @_;
 246
 247   my $geo = delete $opts{geo}
 248     or Carp::confess("missing geo option");
 249
 250   return $self->thumb_base_url
 251     . "?g=$geo&page=$self->{articleId}&image=$self->{id}";
 252 }
 253
 254 sub thumb_base_url {
 255   '/cgi-bin/thumb.pl';
 256 }
 257
 258 sub full_filename {
 259   my ($self) = @_;
 260
 261   return BSE::TB::Images->image_dir() . "/" . $self->image;
 262 }
 263
 264 # compatibility with BSE::TB::File
 265 sub filename {
 266   my ($self) = @_;
 267
 268   return $self->image;
 269 }
 270
 271 =item article
 272
 273 The article this image belongs to.
 274
 275 =cut
 276
 277 sub article {
 278   my ($self) = @_;
 279
 280   if ($self->articleId == -1) {
 281     require BSE::TB::Site;
 282     return BSE::TB::Site->new;
 283   }
 284   else {
 285     require BSE::TB::Articles;
 286     return BSE::TB::Articles->getByPkey($self->articleId);
 287   }
 288 }
 289
 290 =item remove
 291
 292 Remove the image.
 293
 294 =cut
 295
 296 sub remove {
 297   my ($self) = @_;
 298
 299   $self->remove_tags;
 300   unlink $self->full_filename;
 301   return $self->SUPER::remove();
 302 }
 303
 304 =item update
 305
 306 Make updates to the image.
 307
 308 =cut
 309
 310 sub update {
 311   my ($image, %opts) = @_;
 312
 313   my $errors = delete $opts{errors}
 314     or confess "Missing errors parameter";
 315
 316   my $actor = $opts{_actor}
 317     or confess "Missing _actor parameter";
 318
 319   my $warnings = $opts{_warnings}
 320     or confess "Missing _warnings parameter";
 321
 322   require BSE::CfgInfo;
 323   my $cfg = BSE::Cfg->single;
 324   my $image_dir = BSE::CfgInfo::cfg_image_dir($cfg);
 325   my $fh = $opts{fh};
 326   my $fh_field = "fh";
 327   my $delete_file;
 328   my $old_storage = $image->storage;
 329   my $filename;
 330   if ($fh) {
 331     $filename = $opts{display_name}
 332       or confess "Missing display_name";
 333   }
 334   elsif ($opts{file}) {
 335     unless (open $fh, "<", $opts{file}) {
 336       $errors->{filename} = "Cannot open $opts{file}: $!";
 337       return;
 338     }
 339     $fh_field = "file";
 340     $filename = $opts{file};
 341   }
 342   if ($fh) {
 343     local $SIG{__DIE__};
 344     eval {
 345       my $msg;
 346       require DevHelp::FileUpload;
 347       my ($image_name) = DevHelp::FileUpload->
 348         make_fh_copy($fh, $image_dir, $filename, \$msg)
 349           or die "$msg\n";
 350
 351       my $full_filename = "$image_dir/$image_name";
 352       require BSE::ImageSize;
 353       my ($width, $height, $type) = BSE::ImageSize::imgsize($full_filename);
 354       if ($width) {
 355         $delete_file = $image->image;
 356         $image->set_image($image_name);
 357         $image->set_width($width);
 358         $image->set_height($height);
 359         $image->set_storage("local");
 360         $image->set_src(BSE::TB::Images->base_uri . $image_name);
 361         $image->set_ftype(BSE::TB::Images->get_ftype($type));
 362       }
 363       else {
 364         die "$type\n";
 365       }
 366
 367       1;
 368     } or do {
 369       chomp($errors->{$fh_field} = $@);
 370     };
 371   }
 372
 373   my $name = $opts{name};
 374   if (defined $name) {
 375     unless ($name =~ /^[a-z_]\w*$/i) {
 376       $errors->{name} = "msg:bse/admin/edit/image/save/nameformat:$name";
 377     }
 378     if (!$errors->{name} && length $name && $name ne $image->name) {
 379       # check for a duplicate
 380       my @other_images = grep $_->id != $image->id, $image->article->images;
 381       if (grep $name eq $_->name, @other_images) {
 382         $errors->{name} = "msg:bse/admin/edit/image/save/namedup:$name";
 383       }
 384     }
 385   }
 386
 387   if (defined $opts{alt}) {
 388     $image->set_alt($opts{alt});
 389   }
 390
 391   if (defined $opts{url}) {
 392     $image->set_url($opts{url});
 393   }
 394
 395   keys %$errors
 396     and return;
 397
 398   my $new_storage = $opts{storage};
 399   defined $new_storage or $new_storage = $image->storage;
 400   $image->save;
 401
 402   my $mgr = BSE::TB::Images->storage_manager;
 403
 404   if ($delete_file) {
 405     if ($old_storage ne "local") {
 406       $mgr->unstore($delete_file);
 407     }
 408     unlink "$image_dir/$delete_file";
 409
 410     $old_storage = "local";
 411   }
 412
 413   # try to set the storage, this failing doesn't fail the save
 414   eval {
 415     $new_storage =
 416       $mgr->select_store($image->image, $new_storage, $image);
 417     if ($image->storage ne $new_storage) {
 418       # handles both new images (which sets storage to local) and changing
 419       # the storage for old images
 420       $old_storage = $image->storage;
 421       my $src = $mgr->store($image->image, $new_storage, $image);
 422       $image->set_src($src);
 423       $image->set_storage($new_storage);
 424       $image->save;
 425     }
 426     1;
 427   } or do {
 428     my $msg = $@;
 429     chomp $msg;
 430     require BSE::TB::AuditLog;
 431     BSE::TB::AuditLog->log
 432       (
 433        component => "admin:edit:saveimage",
 434        level => "warning",
 435        object => $image,
 436        actor => $actor,
 437        msg => "Error saving image to storage $new_storage: $msg",
 438       );
 439     push @$warnings, "msg:bse/admin/edit/image/save/savetostore:$msg";
 440   };
 441
 442   if ($image->storage ne $old_storage && $old_storage ne "local") {
 443     eval {
 444       $mgr->unstore($image->image, $old_storage);
 445       1;
 446     } or do {
 447       my $msg = $@;
 448       chomp $msg;
 449       require BSE::TB::AuditLog;
 450       BSE::TB::AuditLog->log
 451         (
 452          component => "admin:edit:saveimage",
 453          level => "warning",
 454          object => $image,
 455          actor => $actor,
 456          msg => "Error saving image to storage $new_storage: $msg",
 457         );
 458       push @$warnings, "msg:bse/admin/edit/image/save/delfromstore:$msg";
 459     };
 460   }
 461
 462   return 1;
 463 }
 464
 465 sub tag_owner_type {
 466   "BI"
 467 }
 468
 469 sub tableClass {
 470   "BSE::TB::Images";
 471 }
 472
 473 1;
 474
 475 =back
 476
 477 =head1 INHERITED BEHAVIOUR
 478
 479 Inherits from L<BSE::TB::TagOwner> and L<BSE::ThumbCommon>
 480
 481 =head1 AUTHOR
 482
 483 Tony Cook <tony@develop-help.com>
 484
 485 =cut