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