improve validation and error reporting for article tags
[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;
f40af7e2 6use vars qw/@ISA/;
ecc7c0d0 7@ISA = qw/Squirrel::Row BSE::ThumbCommon/;
f40af7e2 8use Carp qw(confess);
f40af7e2 9
3ea6f4c8 10our $VERSION = "1.006";
cb7fd78d 11
f40af7e2
TC
12sub columns {
13 return qw/id articleId image alt width height url displayOrder name
14 storage src ftype/;
15}
16
f02986d4
TC
17sub table { "image" }
18
f40af7e2
TC
19sub formatted {
20 my ($self, %opts) = @_;
21
22 my $cfg = delete $opts{cfg}
23 or confess "Missing cfg parameter";
24
25 my $handler = $self->_handler_object($cfg);
26
27 return $handler->format
28 (
29 image => $self,
30 %opts,
31 );
32}
33
34sub inline {
35 my ($self, %opts) = @_;
36
37 my $cfg = delete $opts{cfg}
38 or confess "Missing cfg parameter";
39
40 my $handler = $self->_handler_object($cfg);
41
42 return $handler->inline
43 (
44 image => $self,
45 %opts,
46 );
47}
48
3f23129e
TC
49sub popimage {
50 my ($im, %opts) = @_;
51
52 my $cfg = delete $opts{cfg}
53 or confess "Missing cfg parameter";
54
55 my $handler = $im->_handler_object($cfg);
56
57 return $handler->popimage
58 (
59 image => $im,
60 %opts,
61 );
62}
63
f40af7e2 64sub image_url {
d585a3cf 65 my ($im) = @_;
f40af7e2 66
bd903bc5 67 return $im->src || BSE::TB::Images->base_uri . $im->image;
f40af7e2
TC
68}
69
d585a3cf
TC
70sub json_data {
71 my ($self) = @_;
72
73 my $data = $self->data_only;
74 $data->{url} = $self->image_url;
75
76 return $data;
77}
78
ecc7c0d0
TC
79sub dynamic_thumb_url {
80 my ($self, %opts) = @_;
81
82 my $geo = delete $opts{geo}
83 or Carp::confess("missing geo option");
84
85 return $self->thumb_base_url
86 . "?g=$geo&page=$self->{articleId}&image=$self->{id}";
87}
88
89sub thumb_base_url {
90 '/cgi-bin/thumb.pl';
91}
92
93sub full_filename {
94 my ($self) = @_;
95
96 return BSE::TB::Images->image_dir() . "/" . $self->image;
97}
98
99# compatibility with BSE::TB::File
100sub filename {
101 my ($self) = @_;
102
103 return $self->image;
104}
105
bd903bc5
TC
106sub article {
107 my ($self) = @_;
108
109 if ($self->articleId == -1) {
110 require BSE::TB::Site;
111 return BSE::TB::Site->new;
112 }
113 else {
114 require Articles;
115 return Articles->getByPkey($self->articleId);
116 }
117}
118
771ab646
TC
119sub remove {
120 my ($self) = @_;
121
122 unlink $self->full_filename;
123 return $self->SUPER::remove();
124}
125
bd903bc5
TC
126sub update {
127 my ($image, %opts) = @_;
128
129 my $errors = delete $opts{errors}
130 or confess "Missing errors parameter";
131
132 my $actor = $opts{_actor}
133 or confess "Missing _actor parameter";
134
135 my $warnings = $opts{_warnings}
136 or confess "Missing _warnings parameter";
137
138 require BSE::CfgInfo;
139 my $cfg = BSE::Cfg->single;
140 my $image_dir = BSE::CfgInfo::cfg_image_dir($cfg);
141 my $fh = $opts{fh};
142 my $fh_field = "fh";
143 my $delete_file;
144 my $old_storage = $image->storage;
145 my $filename;
146 if ($fh) {
147 $filename = $opts{display_name}
148 or confess "Missing display_name";
149 }
150 elsif ($opts{file}) {
151 unless (open $fh, "<", $opts{file}) {
152 $errors->{filename} = "Cannot open $opts{file}: $!";
153 return;
154 }
155 $fh_field = "file";
156 $filename = $opts{file};
157 }
158 if ($fh) {
159 local $SIG{__DIE__};
160 eval {
161 my $msg;
162 require DevHelp::FileUpload;
163 my ($image_name) = DevHelp::FileUpload->
164 make_fh_copy($fh, $image_dir, $filename, \$msg)
165 or die "$msg\n";
166
167 my $full_filename = "$image_dir/$image_name";
168 require Image::Size;
169 my ($width, $height, $type) = Image::Size::imgsize($full_filename);
170 if ($width) {
171 $delete_file = $image->image;
172 $image->set_image($image_name);
173 $image->set_width($width);
174 $image->set_height($height);
175 $image->set_storage("local");
176 $image->set_src(BSE::TB::Images->base_uri . $image_name);
177 $image->set_ftype(BSE::TB::Images->get_ftype($type));
178 }
179 else {
180 die "$type\n";
181 }
182
183 1;
184 } or do {
185 chomp($errors->{$fh_field} = $@);
186 };
187 }
188
189 my $name = $opts{name};
190 if (defined $name) {
191 unless ($name =~ /^[a-z_]\w*$/i) {
192 $errors->{name} = "msg:bse/admin/edit/image/save/nameformat:$name";
193 }
194 if (!$errors->{name} && length $name && $name ne $image->name) {
195 # check for a duplicate
196 my @other_images = grep $_->id != $image->id, $image->article->images;
197 if (grep $name eq $_->name, @other_images) {
198 $errors->{name} = "msg:bse/admin/edit/image/save/namedup:$name";
199 }
200 }
201 }
202
203 if (defined $opts{alt}) {
204 $image->set_alt($opts{alt});
205 }
206
207 if (defined $opts{url}) {
208 $image->set_url($opts{url});
209 }
210
211 keys %$errors
212 and return;
213
214 my $new_storage = $opts{storage};
215 defined $new_storage or $new_storage = $image->storage;
216 $image->save;
217
218 my $mgr = BSE::TB::Images->storage_manager;
219
220 if ($delete_file) {
221 if ($old_storage ne "local") {
222 $mgr->unstore($delete_file);
223 }
224 unlink "$image_dir/$delete_file";
225
226 $old_storage = "local";
227 }
228
229 # try to set the storage, this failing doesn't fail the save
230 eval {
231 $new_storage =
232 $mgr->select_store($image->image, $new_storage, $image);
233 if ($image->storage ne $new_storage) {
234 # handles both new images (which sets storage to local) and changing
235 # the storage for old images
236 $old_storage = $image->storage;
237 my $src = $mgr->store($image->image, $new_storage, $image);
238 $image->set_src($src);
239 $image->set_storage($new_storage);
240 $image->save;
241 }
242 1;
243 } or do {
244 my $msg = $@;
245 chomp $msg;
246 require BSE::TB::AuditLog;
247 BSE::TB::AuditLog->log
248 (
249 component => "admin:edit:saveimage",
3ea6f4c8 250 level => "warning",
bd903bc5
TC
251 object => $image,
252 actor => $actor,
253 msg => "Error saving image to storage $new_storage: $msg",
254 );
255 push @$warnings, "msg:bse/admin/edit/image/save/savetostore:$msg";
256 };
257
258 if ($image->storage ne $old_storage && $old_storage ne "local") {
259 eval {
260 $mgr->unstore($image->image, $old_storage);
261 1;
262 } or do {
263 my $msg = $@;
264 chomp $msg;
265 require BSE::TB::AuditLog;
266 BSE::TB::AuditLog->log
267 (
268 component => "admin:edit:saveimage",
3ea6f4c8 269 level => "warning",
bd903bc5
TC
270 object => $image,
271 actor => $actor,
272 msg => "Error saving image to storage $new_storage: $msg",
273 );
274 push @$warnings, "msg:bse/admin/edit/image/save/delfromstore:$msg";
275 };
276 }
277
278 return 1;
279}
280
f40af7e2 2811;