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