the image inline method now defaults the cfg parameter
[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.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