1 package SGN
::Controller
::Image
;
4 use namespace
::autoclean
;
10 use URI
::FromHash
'uri';
12 BEGIN { extends
'Catalyst::Controller'; }
14 sub view
:Path
('/image/view/') Args
(1) {
15 my ( $self, $c, $image_id ) = @_;
17 my $dbh = $c->dbc->dbh;
19 my $image = $c->stash->{image
} =
20 SGN
::Image
->new( $dbh, $image_id+0, $c );
22 $image->get_original_filename
23 or $c->throw_404('Image not found.');
25 $c->forward('get_user');
28 template
=> '/image/index.mas',
30 object_id
=> $image_id,
35 sub add
:Path
('/image/add') Args
(0) {
38 $c->forward('require_logged_in');
41 template
=> '/image/add_image.mas',
43 refering_page
=> $c->req->referer() || undef,
44 type
=> $c->req->param('type'),
45 type_id
=> $c->req->param('type_id'),
49 sub confirm
:Path
('/image/confirm') {
52 $c->forward('require_logged_in');
54 my $upload = $c->req->upload('file')
55 or $c->throw( public_message
=> 'No image file uploaded.', is_client_error
=> 1 );
56 my $filename = $upload->filename();
57 my $tempfile = $upload->tempname();
58 #print STDERR "FILENAME: $filename TEMPNAME: $tempfile\n";
61 die "No tempfile $tempfile\n";
64 my $filename_validation_msg = $self->validate_image_filename(basename
($filename));
65 if ( $filename_validation_msg ) { #if non-blank, there is a problem with Filename, print messages
67 unlink $tempfile; # remove upload! prevents more errors on item we have rejected
69 $c->throw( public_message
=> <<EOM, is_client_error => 1 );
70 There is a problem with the image file you selected: $filename <br />
71 Error: $filename_validation_msg <br />
75 my $image_url = $c->tempfiles_subdir('image')."/".basename
($tempfile);
76 my $confirm_filename = $c->get_conf('basepath')."/".$image_url;
77 if (! -e
$tempfile) { die "Temp file does not exit $tempfile\n"; }
78 if (!$upload->copy_to( $confirm_filename )) {
79 die "Error copying $tempfile to $confirm_filename\n";
83 type
=> $c->req->param('type'),
84 refering_page
=> $c->req->param('refering_page'),
85 type_id
=> $c->req->param('type_id'),
86 filename
=> $filename,
87 tempfile
=> basename
($tempfile),
88 image_url
=> $image_url,
93 sub store
:Path
('/image/store') {
97 $c->forward('require_logged_in');
99 my $image = SGN
::Image
->new( $c->dbc->dbh(), undef, $c );
101 my $tempfile = $c->req()->param('tempfile');
102 my $filename = $c->req()->param('filename');
103 my $type = $c->req()->param('type');
104 my $type_id = $c->req()->param('type_id');
105 my $refering_page = $c->req()->param('refering_page');
108 my $temp_image_dir = $c->get_conf("basepath")."/".$c->tempfiles_subdir('image');
110 $image->set_sp_person_id( $c->stash->{person_id
} );
112 if ((my $err = $image->process_image($temp_image_dir."/".$tempfile, $type, $type_id))<=0) {
113 die "An error occurred during the upload. Is the file you are uploading an image file? [$err] ";
117 # set some image attributes...
119 #print STDERR "Setting the submitter information in the image object...\n";
121 $image->set_name($filename);
125 # send_image_email($c, "store", $image, $sp_person_id, $refering_page, $type, $type_id);
126 #remove the temp_file
128 unlink $temp_image_dir."/".$tempfile;
130 my $image_id = $image->get_image_id();
132 # go to the image detail page
133 # open for editing.....
134 $c->res->redirect( $c->uri_for('view',$image_id )->relative() );
137 sub validate_image_filename
:Private
{
140 my %file_types = ( '.jpg' => 'JPEG file',
141 '.jpeg' => 'JPEG file',
142 '.gif' => 'GIF file',
143 '.pdf' => 'PDF file',
145 '.eps' => 'EPS file',
146 '.png' => 'PNG file');
148 # first test is non-acceptable characters in filename
149 my $OK_CHARS='-a-zA-Z0-9_.@\ '; # as recommend by CERT, test for what you will allow
151 $test_fn =~ s/[^$OK_CHARS]/_/go;
152 if ( $fn ne $test_fn ) {
153 #print STDERR "Upload Attempt with bad shell characters: $fn \n";
154 return "Invalid characters found in filename, must not contain
155 characters <b>\& ; : \` \' \\ \| \* \? ~ ^ < > ( ) [ ] { } \$</b>" ;
159 if ($fn =~ m/^(.*)(\.\S{1,4})\r*$/) {
161 #print STDERR "Upload Attempt with disallowed filename extension: $fn Extension: $ext\n";
162 return "File Type must be one of: .png, .jpg, .jpeg, .gif, .pdf, .ps, or .eps" unless exists $file_types{$ext};
164 #print STDERR "Upload Attempt with filename extension we could not parse: $fn \n";
165 return "File Type must be one of: .png, .jpg, .jpeg, .gif, .pdf, .ps, or .eps";
168 return 0; # FALSE, if passes all tests
171 sub send_image_email
:Private
{
176 my $sp_person_id = shift;
177 my $refering_page=shift;
178 my $type= shift; #locus or...?
179 my $type_id = shift; #the database id of the refering object (locus..)
181 my $image_id = $image->get_image_id();
183 my $person= CXGN
::People
::Person
->new($c->dbc->dbh, $sp_person_id);
184 my $user=$person->get_first_name()." ".$person->get_last_name();
189 my $user_link = qq | http
://sgn
.cornell
.edu
/solpeople/personal
-info
.pl?sp_person_id
=$sp_person_id|;
190 my $usermail=$person->get_contact_email();
191 my $image_link = qq |http
://sgn
.cornell
.edu
/image/?image_id
=$image_id|;
192 if ($type eq 'locus') {
193 $type_link = qq | http
://sgn
.cornell
.edu
/phenome/locus_display
.pl?locus_id
=$type_id|;
195 # elsif ($type eq 'allele') {
196 # $type_link = qq | http://sgn.cornell.edu/phenome/allele.pl?allele_id=$type_id|;
198 # elsif ($type eq 'population') {
199 # $type_link = qq | http://sgn.cornell.edu/phenome/population.pl?population_id=$type_id|;
205 if ($action eq 'store') {
207 $subject="[New image associated with $type: $type_id]";
208 $fdbk_body="$user ($user_link) has associated image $image_link \n with $type: $type_link";
210 elsif($action eq 'delete') {
213 $subject="[A image-$type association removed from $type: $type_id]";
214 $fdbk_body="$user ($user_link) has removed publication $image_link \n from $type: $type_link";
217 CXGN
::Contact
::send_email
($subject,$fdbk_body, 'sgn-db-curation@sgn.cornell.edu');
221 sub get_user
: Private
{
222 my ( $self, $c ) = @_;
224 my $dbh = $c->dbc->dbh;
227 $c->stash->{person_id
} =
228 $c->stash->{sp_person_id
} =
229 CXGN
::Login
->new( $c->dbc->dbh )->has_session();
232 $c->stash->{person
} = CXGN
::People
::Person
->new( $dbh, $person_id );
237 sub require_logged_in
: Private
{
238 my ( $self, $c ) = @_;
240 $c->forward('get_user');
242 unless( $c->stash->{person_id
} ) {
243 $c->res->redirect( uri
( path
=> '/solpeople/login.pl', query
=> { goto_url
=> $c->req->uri->path_query } ) );