0a05d3dc3b9e5857160ce9fe48ce293ab80664a1
[bse.git] / 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