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.010";
  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}
 149     or confess "Missing cfg parameter";
 150
 151   my $handler = $self->_handler_object($cfg);
 152
 153   return $handler->inline
 154     (
 155      image => $self,
 156      %opts,
 157     );
 158 }
 159
 160 =item popimage(...)
 161
 162 Call the popimage() image handler object for this image, displaying
 163 the image as a thumbnail that displays a larger version when clicked.
 164
 165 Parameters:
 166
 167 =over
 168
 169 =item *
 170
 171 C<class> - controls the section of the config file that popup
 172 parameters are taken from.
 173
 174 =item *
 175
 176 C<static> - true to use static URLs for the thumbnails.
 177
 178 =back
 179
 180 Returns HTML.
 181
 182 =cut
 183
 184 sub popimage {
 185   my ($im, %opts) = @_;
 186
 187   my $cfg = delete $opts{cfg}
 188     or confess "Missing cfg parameter";
 189
 190   my $handler = $im->_handler_object($cfg);
 191
 192   return $handler->popimage
 193     (
 194      image => $im,
 195      %opts,
 196     );
 197 }
 198
 199 =item image_url
 200
 201 Return the image's source URL.  This will be the storage URL if the
 202 image is C<storage> is not C<local>.
 203
 204 =cut
 205
 206 sub image_url {
 207   my ($im) = @_;
 208
 209   return $im->src || BSE::TB::Images->base_uri . $im->image;
 210 }
 211
 212 =item json_data
 213
 214 Returns the image data as a data structure suitable for conversion to
 215 JSON.
 216
 217 =cut
 218
 219 sub json_data {
 220   my ($self) = @_;
 221
 222   my $data = $self->data_only;
 223   $data->{url} = $self->image_url;
 224   $data->{tags} = [ $self->tags ];
 225
 226   return $data;
 227 }
 228
 229 =item dynamic_thumb_url(...)
 230
 231 Return a dynamic URL to a thumbnail of the image.
 232
 233 Requires one named parameter:
 234
 235 =over
 236
 237 =item *
 238
 239 C<geo> - the thumbnail geometry to use.
 240
 241 =back
 242
 243 =cut
 244
 245 sub dynamic_thumb_url {
 246   my ($self, %opts) = @_;
 247
 248   my $geo = delete $opts{geo}
 249     or Carp::confess("missing geo option");
 250
 251   return $self->thumb_base_url
 252     . "?g=$geo&page=$self->{articleId}&image=$self->{id}";
 253 }
 254
 255 sub thumb_base_url {
 256   '/cgi-bin/thumb.pl';
 257 }
 258
 259 sub full_filename {
 260   my ($self) = @_;
 261
 262   return BSE::TB::Images->image_dir() . "/" . $self->image;
 263 }
 264
 265 # compatibility with BSE::TB::File
 266 sub filename {
 267   my ($self) = @_;
 268
 269   return $self->image;
 270 }
 271
 272 =item article
 273
 274 The article this image belongs to.
 275
 276 =cut
 277
 278 sub article {
 279   my ($self) = @_;
 280
 281   if ($self->articleId == -1) {
 282     require BSE::TB::Site;
 283     return BSE::TB::Site->new;
 284   }
 285   else {
 286     require BSE::TB::Articles;
 287     return BSE::TB::Articles->getByPkey($self->articleId);
 288   }
 289 }
 290
 291 =item remove
 292
 293 Remove the image.
 294
 295 =cut
 296
 297 sub remove {
 298   my ($self) = @_;
 299
 300   $self->remove_tags;
 301   unlink $self->full_filename;
 302   return $self->SUPER::remove();
 303 }
 304
 305 =item update
 306
 307 Make updates to the image.
 308
 309 =cut
 310
 311 sub update {
 312   my ($image, %opts) = @_;
 313
 314   my $errors = delete $opts{errors}
 315     or confess "Missing errors parameter";
 316
 317   my $actor = $opts{_actor}
 318     or confess "Missing _actor parameter";
 319
 320   my $warnings = $opts{_warnings}
 321     or confess "Missing _warnings parameter";
 322
 323   require BSE::CfgInfo;
 324   my $cfg = BSE::Cfg->single;
 325   my $image_dir = BSE::CfgInfo::cfg_image_dir($cfg);
 326   my $fh = $opts{fh};
 327   my $fh_field = "fh";
 328   my $delete_file;
 329   my $old_storage = $image->storage;
 330   my $filename;
 331   if ($fh) {
 332     $filename = $opts{display_name}
 333       or confess "Missing display_name";
 334   }
 335   elsif ($opts{file}) {
 336     unless (open $fh, "<", $opts{file}) {
 337       $errors->{filename} = "Cannot open $opts{file}: $!";
 338       return;
 339     }
 340     $fh_field = "file";
 341     $filename = $opts{file};
 342   }
 343   if ($fh) {
 344     local $SIG{__DIE__};
 345     eval {
 346       my $msg;
 347       require DevHelp::FileUpload;
 348       my ($image_name) = DevHelp::FileUpload->
 349         make_fh_copy($fh, $image_dir, $filename, \$msg)
 350           or die "$msg\n";
 351
 352       my $full_filename = "$image_dir/$image_name";
 353       require BSE::ImageSize;
 354       my ($width, $height, $type) = BSE::ImageSize::imgsize($full_filename);
 355       if ($width) {
 356         $delete_file = $image->image;
 357         $image->set_image($image_name);
 358         $image->set_width($width);
 359         $image->set_height($height);
 360         $image->set_storage("local");
 361         $image->set_src(BSE::TB::Images->base_uri . $image_name);
 362         $image->set_ftype(BSE::TB::Images->get_ftype($type));
 363       }
 364       else {
 365         die "$type\n";
 366       }
 367
 368       1;
 369     } or do {
 370       chomp($errors->{$fh_field} = $@);
 371     };
 372   }
 373
 374   my $name = $opts{name};
 375   if (defined $name) {
 376     unless ($name =~ /^[a-z_]\w*$/i) {
 377       $errors->{name} = "msg:bse/admin/edit/image/save/nameformat:$name";
 378     }
 379     if (!$errors->{name} && length $name && $name ne $image->name) {
 380       # check for a duplicate
 381       my @other_images = grep $_->id != $image->id, $image->article->images;
 382       if (grep $name eq $_->name, @other_images) {
 383         $errors->{name} = "msg:bse/admin/edit/image/save/namedup:$name";
 384       }
 385     }
 386   }
 387
 388   if (defined $opts{alt}) {
 389     $image->set_alt($opts{alt});
 390   }
 391
 392   if (defined $opts{url}) {
 393     $image->set_url($opts{url});
 394   }
 395
 396   keys %$errors
 397     and return;
 398
 399   my $new_storage = $opts{storage};
 400   defined $new_storage or $new_storage = $image->storage;
 401   $image->save;
 402
 403   my $mgr = BSE::TB::Images->storage_manager;
 404
 405   if ($delete_file) {
 406     if ($old_storage ne "local") {
 407       $mgr->unstore($delete_file);
 408     }
 409     unlink "$image_dir/$delete_file";
 410
 411     $old_storage = "local";
 412   }
 413
 414   # try to set the storage, this failing doesn't fail the save
 415   eval {
 416     $new_storage =
 417       $mgr->select_store($image->image, $new_storage, $image);
 418     if ($image->storage ne $new_storage) {
 419       # handles both new images (which sets storage to local) and changing
 420       # the storage for old images
 421       $old_storage = $image->storage;
 422       my $src = $mgr->store($image->image, $new_storage, $image);
 423       $image->set_src($src);
 424       $image->set_storage($new_storage);
 425       $image->save;
 426     }
 427     1;
 428   } or do {
 429     my $msg = $@;
 430     chomp $msg;
 431     require BSE::TB::AuditLog;
 432     BSE::TB::AuditLog->log
 433       (
 434        component => "admin:edit:saveimage",
 435        level => "warning",
 436        object => $image,
 437        actor => $actor,
 438        msg => "Error saving image to storage $new_storage: $msg",
 439       );
 440     push @$warnings, "msg:bse/admin/edit/image/save/savetostore:$msg";
 441   };
 442
 443   if ($image->storage ne $old_storage && $old_storage ne "local") {
 444     eval {
 445       $mgr->unstore($image->image, $old_storage);
 446       1;
 447     } or do {
 448       my $msg = $@;
 449       chomp $msg;
 450       require BSE::TB::AuditLog;
 451       BSE::TB::AuditLog->log
 452         (
 453          component => "admin:edit:saveimage",
 454          level => "warning",
 455          object => $image,
 456          actor => $actor,
 457          msg => "Error saving image to storage $new_storage: $msg",
 458         );
 459       push @$warnings, "msg:bse/admin/edit/image/save/delfromstore:$msg";
 460     };
 461   }
 462
 463   return 1;
 464 }
 465
 466 sub tag_owner_type {
 467   "BI"
 468 }
 469
 470 sub tableClass {
 471   "BSE::TB::Images";
 472 }
 473
 474 1;
 475
 476 =back
 477
 478 =head1 INHERITED BEHAVIOUR
 479
 480 Inherits from L<BSE::TB::TagOwner> and L<BSE::ThumbCommon>
 481
 482 =head1 AUTHOR
 483
 484 Tony Cook <tony@develop-help.com>
 485
 486 =cut