added availability
[sgn.git] / cgi-bin / image / add_image.pl
blob3178867d9269ec00caf87f2c059e5e02dd6b62a0
1 use CatalystX::GlobalContext qw( $c );
3 =head1 NAME
5 add_image.pl - a web script to add image to the SGN database
7 =head1 DESCRIPTION
9 uploads an image to the SGN image database (the image table in the metadata schema) and places the image on the file system (using the conf object's image_dir parameters), resizes the image to thumbnail size etc. This is different from the deprecated CXGN::Insitu::Image, which had similar functionality, but was too insitu specific.
11 =head2 IMPORTANT NOTE
13 The uploaded images will be stored using the SGN::Image object. This object stores meta-information in the SGN database, and the image on disk. The file location is given by the $c SGN:Context variable "image_dir". On the production server, this should be set to "/data/shared/website/image/image_files". To prevent different image to clobber the image_dir, that variable needs to be set to "/data/shared/website/image/image_files_sandbox" for the devel server. When the cxgn database is copied to sandbox, the corresponding image_dir needs to be copied over as well. Check these variables before adding images.
15 =head1 USAGE
17 This web script uses 3 stages for uploading an image, each step has its own set of parameters, explained below:
19 =head2 New image
21 This call will present the user with the option of selecting a file for upload.
23 =over 3
25 =item o
27 I<action>: needs to be set to "new"
29 =item o
31 I<type>: either experiment, stock, locus, or to be defined data types in the SGN database that can have associated images (fish etc).
33 =item o
35 I<type_id>: the primary key of the object of type "type" to which this image should be associated.
37 =item o
39 I<refering_page>: the page that requested the image upload.
41 =back
43 =head2 Confirm upload
45 before the image is uploaded, a confirm step occurs. The confirm step has to be called with the following parameters:
47 =over 3
49 =item o
51 I<action>: needs to be set to confirm
53 =item o
55 I<type>: see above
57 =item o
59 I<file>: the file to upload
61 =item o
63 I<refering_page>: The page that requested the image upload.
65 =back
67 =head2 Store image
69 This step will actually store the image in the SGN database. It then client_redirects to the image detail page for that image, such that hitting reload will not cause the image to be uploaded again.
71 =over 3
73 =item o
75 I<action>=store
77 =item o
79 I<type>: see above
81 =item o
83 I<type_id>: see above
85 =item o
87 I<refering_page>: the url of the refering page
89 =item o
91 I<temp_file>: the temp_file basename of the temporarily uploaded file in the designated temp_dir
93 =back
95 =head2 NOTES
97 Please note the following restrictions:
99 =over 4
101 =item o
103 Note that only post requests are supported for the image upload, with an enctype of multipart/form-data.
105 =item o
107 The user needs to be logged in and needs "submitter" privileges.
109 =back
111 =head1 SEE ALSO
113 The script that deals with displaying and editing the meta information is /image/index.pl .
114 This script is based on the L<SGN::Image> object.
116 =head1 VERSION
118 Version 0.6, Dec 20, 2006.
120 =head1 AUTHOR(S)
122 Lukas Mueller (lam87@cornell.edu)
124 =head1 FUNCTIONS
126 The following functions are documented in this script:
128 =cut
130 use strict;
132 use CXGN::DB::Connection;
133 use CXGN::Page;
134 use CXGN::Page::FormattingHelpers qw / blue_section_html page_title_html / ;
135 use SGN::Image;
136 use CXGN::People::Person;
137 use CXGN::Contact;
139 # get the parameters.
140 # legal parameters are:
141 # action: new upload
142 # image_id: a valid image_id
143 # experiment_id: a valid experiment_id
144 # upload_file: the file to be uploaded, if action=upload.
147 my $request = shift;
150 my $page = CXGN::Page->new();
152 my %args = $page->get_all_encoded_arguments;
154 # get db connection
156 my $dbh = CXGN::DB::Connection->new();
158 # get the sp_person_id if user is logged in for actions add and upload.
160 my $user = undef;
161 my $sp_person_id=undef;
162 if ($args{action} =~/new|confirm|store/i ) {
163 my $login = CXGN::Login->new($dbh);
164 $sp_person_id = $login ->verify_session();
165 $user = CXGN::People::Person->new($dbh, $sp_person_id);
166 #$sp_person_id= $user->get_sp_person_id();
167 if ($user->get_user_type() !~ /curator|submitter/) {
168 $page->message_page("You do not have sufficient privileges to upload images. You need an account of type 'submitter'. Please contact SGN to change your account type. Sorry.");
171 else {
172 $page->message_page("Unknown action $args{action}. What do you want to do exactly?");
175 # create an new image object and go through the different
176 # possible actions. Emit error pages if needed.
178 my $image = SGN::Image->new( $dbh, undef, $c );
180 if ($args{action} eq "new") {
181 # check stuff
183 # do stuff
184 add_dialog($page, $image, %args);
187 elsif ($args{action} eq "confirm") {
188 # check stuff
190 # do stuff
191 confirm($dbh, $page, %args);
193 elsif ($args{action} eq "store") {
194 # check stuff
196 # do stuff
197 $args{sp_person_id} = $sp_person_id ;
198 store($dbh, $page, $image, %args);
200 else {
201 $page->message_page("No valid parameters were supplied.");
205 =head2 add_dialog
207 Usage: add_dialog($page, $image, %args)
208 Desc: Add dialog displays a page allowing to select and submit
209 an image file
210 Ret:
211 Args: $page: a page object
212 $image: an image object (empty)
213 $args{type}: either "stock" or "experiment"
214 $args{type_id}: the primary key identifying the object
215 of type $args{type}
216 $args{refering_page}: The page that has called the
217 add_image script.
218 This is used to show a link to the calling script.
219 Side Effects:
220 Example:
222 =cut
224 sub add_dialog {
225 my $page = shift;
226 my $image = shift;
227 my %args = @_;
229 $page->header();
231 print page_title_html("Add image to $args{type} $args{type_id}" );
233 print qq {
235 <p class="boxbgcolor2">Note: By pressing the "Upload" button, you are considered to be the copyright owner of the image being uploaded and that you grant a non-exclusive license to SGN to display and use the image on SGN webpages and materials related to SGN.<br /></p>
236 <p> Supported file formats include .jpg. .jpeg, .gif, .png, .pdf, .ps,
237 .eps <br></p>
238 <form action="add_image.pl" method="post" enctype="multipart/form-data" >
239 Upload an image, and associated with object <b>$args{type}</b> id $args{type_id}<br /><br />
240 <input type="file" name="file" value="Choose image file" />
241 <input type="hidden" name="action" value="confirm" /><br /><br />
242 <input type="hidden" name="type" value="$args{type}" />
243 <input type="hidden" name="type_id" value="$args{type_id}" />
244 <input type="hidden" name="refering_page" value="$args{refering_page}" />
245 <input type="submit" value="Upload" />
246 </form>
249 if ($args{refering_page}) { print "<a href=\"$args{refering_page}\">Go back</a>"; }
251 $page->footer();
254 =head2 confirm
256 Usage:
257 Desc:
258 Ret:
259 Args:
260 Side Effects:
261 Example:
263 =cut
265 sub confirm {
266 my $dbh = shift;
267 my $page = shift;
268 my %args = @_;
271 # deal with the upload options
273 my $upload = $page->get_upload();
274 my $upload_fh;
276 if (defined $upload) {
279 $args{temp_file} = $image->apache_upload_image($upload);
280 #if ($temp_file eq "-1") {
281 # $page->message_page("It seems that this file is in the process of being uploaded. Please do not upload files several times!!!! ");
284 my $temp_file_base = File::Basename::basename($args{temp_file});
285 my $sample_image = $temp_file_base;
287 $page->header();
289 my $filename_validation_msg = validate_image_filename($temp_file_base);
290 if ( $filename_validation_msg ) { #if non-blank, there is a problem with Filename, print messages
291 #print STDERR "Invalid Upload Filename Attempt: $temp_file_base, $filename_validation_msg \n";
292 print qq { There is a problem with the image file you selected: $temp_file_base <br />};
293 print qq { Error: };
294 print $filename_validation_msg;
295 print qq {<br />};
296 unlink $args{temp_file}; # remove upload! prevents more errors on item we have rejected
297 if ($args{refering_page}) { print "<a href=\"$args{refering_page}\">[Return]</a><br /><br />\n"; }
298 } else {
299 ### deanx Testing -- this is trashable
300 if ($temp_file_base =~ /(.*)\.(.{1,4})$/ ) {
301 if ( $2 =~ /[pdf|ps|eps]/i ) {
302 SGN::Image::iconify_file($args{temp_file});
303 $sample_image = $temp_file_base.'.jpg';
307 print qq { The image uploaded is shown below. Please click on "Store in SGN database" to permanently store the image in the database. <br /> };
309 print "<br /><br />\n";
310 if ($args{type} && $args{type_id}) { print "<b>Association</b> $args{type} id $args{type_id}<br /><br />\n"; }
312 print "Submitter: $sp_person_id<br />\n";
314 print qq {
315 <form method="get">
316 <input type="hidden" name="temp_file" value="$temp_file_base" />
317 <input type="hidden" name="action" value="store" />
318 <input type="hidden" name="type" value="$args{type}" />
319 <input type="hidden" name="type_id" value="$args{type_id}" />
320 <input type="submit" value="Store in SGN database" />
322 </form>
325 if ($args{refering_page}) { print "<a href=\"$args{refering_page}\">[Cancel]</a><br /><br />\n"; }
327 print qq { <img src="/documents/tempfiles/temp_images/$sample_image" /> };
329 $page->footer();
331 } # Ok filename
333 else {
334 $page->error_page("A freakin error occurred!");
340 =head2 store
342 Usage:
343 Desc:
344 Ret:
345 Args: $dbh - a database handle
346 $page - a page object
347 $image - an image object
348 %args, with the following key/values:
349 $args{file} -
350 $args{temp_file} -
351 $args{type} -
352 $args{type_id} -
353 $args{refering_page} -
354 $args{sp_person_id} -
355 Side Effects:
356 Example:
358 =cut
360 # store($dbh, $page, $file, $image, $type, $type_id, $refering_page, $sp_person_id);
361 sub store {
362 my ($dbh, $page, $image, %args) = @_;
363 my $sp_person_id = $args{sp_person_id};
365 my $temp_image_dir = $c->get_conf("basepath")."/".$c->get_conf("tempfiles_subdir") ."/temp_images";
367 $image -> set_sp_person_id($sp_person_id);
369 if ((my $err = $image->process_image($temp_image_dir."/".$args{temp_file}, $args{type}, $args{type_id}))<=0) {
370 $page->message_page("An error occurred during the upload. Is the file you are uploading an image file? [$err] ");
371 exit();
374 # set some image attributes...
375 # the image owner...
376 #print STDERR "Setting the submitter information in the image object...\n";
378 $image -> set_name($args{file});
381 $image->store();
383 send_image_email($dbh, $image, $sp_person_id, %args);
384 #remove the temp_file
386 unlink ($temp_image_dir."/".$args{temp_file});
388 $args{image_id}=$image->get_image_id();
391 # go to the image detail page
392 # open for editing.....
393 $page->client_redirect("/image/?image_id=$args{image_id}&action=edit");
396 =head2 store
398 Usage: validate_image_filename($filename);
399 Desc: Validate the Upload Image file string seems reasonable
400 Ret: Returns 0 if file name OK, otherwise returns appropriate error msg
401 Args: $filename
403 Side Effects:
404 Example:
406 =cut
408 sub validate_image_filename {
409 my $fn = shift;
410 my %file_types = ( '.jpg' => 'JPEG file',
411 '.jpeg' => 'JPEG file',
412 '.gif' => 'GIF file',
413 '.pdf' => 'PDF file',
414 '.ps' => 'PS file',
415 '.eps' => 'EPS file',
416 '.png' => 'PNG file');
420 # first test is non-acceptable characters in filename
421 my $OK_CHARS='-a-zA-Z0-9_.@\ '; # as recommend by CERT, test for what you will allow
422 my $test_fn = $fn;
423 $test_fn =~ s/[^$OK_CHARS]/_/go;
424 if ( $fn ne $test_fn ) {
425 #print STDERR "Upload Attempt with bad shell characters: $fn \n";
426 return "Invalid characters found in filename, must not contain
427 characters <b>\& ; : \` \' \\ \| \* \? ~ ^ < > ( ) [ ] { } \$</b>" ;
432 my $ext;
433 if ($fn =~ m/^(.*)(\.\S{1,4})\r*$/) {
434 $ext = lc ($2);
435 #print STDERR "Upload Attempt with disallowed filename extension: $fn Extension: $ext\n";
436 return "File Type must be one of: .png, .jpg, .jpeg, .gif, .pdf, .ps, or .eps" unless exists $file_types{$ext};
437 } else {
438 #print STDERR "Upload Attempt with filename extension we could not parse: $fn \n";
439 return "File Type must be one of: .png, .jpg, .jpeg, .gif, .pdf, .ps, or .eps";
442 return 0; # FALSE, if passes all tests
445 sub send_image_email {
446 my $dbh = shift;
447 my $image = shift;
448 my $sp_person_id = shift;
449 my %args = @_;
450 my $refering_page=$args{refering_page};
451 my $type= $args{type}; #locus or...?
452 my $type_id = $args{type_id}; #the database id of the refering object (locus..)
453 my $image_id = $image->get_image_id();
454 my $action = $args{action};
455 #my $sp_person_id = $args{sp_person_id};
457 my $person= CXGN::People::Person->new($dbh, $sp_person_id);
458 my $user=$person->get_first_name()." ".$person->get_last_name();
460 my $type_link;
463 my $user_link = qq | http://sgn.cornell.edu/solpeople/personal-info.pl?sp_person_id=$sp_person_id|;
464 my $usermail=$person->get_contact_email();
465 my $image_link = qq |http://sgn.cornell.edu/image/?image_id=$image_id|;
466 if ($type eq 'locus') {
467 $type_link = qq | http://sgn.cornell.edu/phenome/locus_display.pl?locus_id=$type_id|;
469 # elsif ($type eq 'allele') {
470 # $type_link = qq | http://sgn.cornell.edu/phenome/allele.pl?allele_id=$type_id|;
472 # elsif ($type eq 'population') {
473 # $type_link = qq | http://sgn.cornell.edu/phenome/population.pl?population_id=$type_id|;
476 my $fdbk_body;
477 my $subject;
479 if ($action eq 'store') {
481 $subject="[New image associated with $type: $type_id]";
482 $fdbk_body="$user ($user_link) has associated image $image_link \n with $type: $type_link";
484 elsif($action eq 'delete') {
487 $subject="[A image-$type association removed from $type: $type_id]";
488 $fdbk_body="$user ($user_link) has removed publication $image_link \n from $type: $type_link";
491 CXGN::Contact::send_email($subject,$fdbk_body, 'sgn-db-curation@sgn.cornell.edu');