the image inline method now defaults the cfg parameter
[bse.git] / site / cgi-bin / modules / BSE / TB / Image.pm
CommitLineData
f40af7e2
TC
1package BSE::TB::Image;
2use strict;
3# represents an image from the database
4use Squirrel::Row;
ecc7c0d0 5use BSE::ThumbCommon;
a3e0dbc8 6use BSE::TB::TagOwner;
f40af7e2 7use vars qw/@ISA/;
a3e0dbc8 8@ISA = qw/Squirrel::Row BSE::ThumbCommon BSE::TB::TagOwner/;
f40af7e2 9use Carp qw(confess);
f40af7e2 10
d43dba91 11our $VERSION = "1.011";
c284ccb4
TC
12
13=head1 NAME
14
15BSE::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
23X<images>This class represents an image attached to an article, or a
24global image.
25
26=head1 METHODS
27
28=over
29
30=item id
31
32Unique id for this image.
33
34=item articleId
35
36article this image belongs to. C<-1> for global images.
37
38=item image
39
40image filename as stored in the images directory. See C</image_url>
41to get a URL to the image.
42
43=item alt
44
45alternate text for the image
46
47=item width
48
49=item height
50
51X<image, width>X<image, height>width and height of the
52image in pixels.
53
54=item url
55
56url to link to when the image is inlined.
57
58=item displayOrder
59
60sort key for ordering images belonging to an article (or within the
61global image collection.)
62
63=item name
64
65unique 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
70the external storage used for the image, or C<local> for locally
71stored images.
72
73=item src
74
75for externally stored images, the URL to the image. Use
76C</image_url()>.
77
78=item ftype
79
ea0b8f8e
TC
80the type of image, either C<img> for normal images, C<svg> for SVG
81images or C<flash> for flash files.
c284ccb4
TC
82
83=cut
cb7fd78d 84
f40af7e2
TC
85sub columns {
86 return qw/id articleId image alt width height url displayOrder name
87 storage src ftype/;
88}
89
f02986d4
TC
90sub table { "image" }
91
c284ccb4
TC
92=item formatted(...)
93
94Call the format() image handler object for this image.
95
96Accepts the following parameters:
97
98=over
99
100=item *
101
102C<align> - sets the align attribute.
103
104=item *
105
106C<extras> - extra C<img> tag attributes.
107
108=back
109
110Returns HTML.
111
112=cut
113
f40af7e2
TC
114sub 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
c284ccb4
TC
129=item inline(...)
130
131Inline the image, accepts the following parameters:
132
133=over
134
135=item *
136
137C<align> - set class to C<< bse_image_I<align> >>.
138
139=back
140
141Returns HTML.
142
143=cut
144
f40af7e2
TC
145sub inline {
146 my ($self, %opts) = @_;
147
d43dba91 148 my $cfg = delete $opts{cfg} || BSE::Cfg->single;
f40af7e2
TC
149
150 my $handler = $self->_handler_object($cfg);
151
152 return $handler->inline
153 (
154 image => $self,
155 %opts,
156 );
157}
158
c284ccb4
TC
159=item popimage(...)
160
161Call the popimage() image handler object for this image, displaying
162the image as a thumbnail that displays a larger version when clicked.
163
164Parameters:
165
166=over
167
168=item *
169
170C<class> - controls the section of the config file that popup
171parameters are taken from.
172
173=item *
174
175C<static> - true to use static URLs for the thumbnails.
176
177=back
178
179Returns HTML.
180
181=cut
182
3f23129e
TC
183sub 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
c284ccb4
TC
198=item image_url
199
200Return the image's source URL. This will be the storage URL if the
201image is C<storage> is not C<local>.
202
203=cut
204
f40af7e2 205sub image_url {
d585a3cf 206 my ($im) = @_;
f40af7e2 207
bd903bc5 208 return $im->src || BSE::TB::Images->base_uri . $im->image;
f40af7e2
TC
209}
210
c284ccb4
TC
211=item json_data
212
213Returns the image data as a data structure suitable for conversion to
214JSON.
215
216=cut
217
d585a3cf
TC
218sub json_data {
219 my ($self) = @_;
220
221 my $data = $self->data_only;
222 $data->{url} = $self->image_url;
a3e0dbc8 223 $data->{tags} = [ $self->tags ];
d585a3cf
TC
224
225 return $data;
226}
227
c284ccb4
TC
228=item dynamic_thumb_url(...)
229
230Return a dynamic URL to a thumbnail of the image.
231
232Requires one named parameter:
233
234=over
235
236=item *
237
238C<geo> - the thumbnail geometry to use.
239
240=back
241
242=cut
243
ecc7c0d0
TC
244sub 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
254sub thumb_base_url {
255 '/cgi-bin/thumb.pl';
256}
257
258sub full_filename {
259 my ($self) = @_;
260
261 return BSE::TB::Images->image_dir() . "/" . $self->image;
262}
263
264# compatibility with BSE::TB::File
265sub filename {
266 my ($self) = @_;
267
268 return $self->image;
269}
270
c284ccb4
TC
271=item article
272
273The article this image belongs to.
274
275=cut
276
bd903bc5
TC
277sub article {
278 my ($self) = @_;
279
280 if ($self->articleId == -1) {
281 require BSE::TB::Site;
282 return BSE::TB::Site->new;
283 }
284 else {
e0ed81d7
AO
285 require BSE::TB::Articles;
286 return BSE::TB::Articles->getByPkey($self->articleId);
bd903bc5
TC
287 }
288}
289
c284ccb4
TC
290=item remove
291
292Remove the image.
293
294=cut
295
771ab646
TC
296sub remove {
297 my ($self) = @_;
298
a3e0dbc8 299 $self->remove_tags;
771ab646
TC
300 unlink $self->full_filename;
301 return $self->SUPER::remove();
302}
303
c284ccb4
TC
304=item update
305
306Make updates to the image.
307
308=cut
309
bd903bc5
TC
310sub 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";
ea0b8f8e
TC
352 require BSE::ImageSize;
353 my ($width, $height, $type) = BSE::ImageSize::imgsize($full_filename);
bd903bc5
TC
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",
3ea6f4c8 434 level => "warning",
bd903bc5
TC
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",
3ea6f4c8 453 level => "warning",
bd903bc5
TC
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
a3e0dbc8
TC
465sub tag_owner_type {
466 "BI"
467}
468
469sub tableClass {
470 "BSE::TB::Images";
471}
472
f40af7e2 4731;
c284ccb4
TC
474
475=back
476
477=head1 INHERITED BEHAVIOUR
478
479Inherits from L<BSE::TB::TagOwner> and L<BSE::ThumbCommon>
480
481=head1 AUTHOR
482
483Tony Cook <tony@develop-help.com>
484
485=cut