Merge pull request #5205 from solgenomics/topic/generic_trial_upload
[sgn.git] / lib / SGN / Role / Site / Exceptions.pm
blob0637c43fa0352ed00db95dbcef1b3eba006ead92
1 =head1 NAME
3 SGN::Role::Site::Exceptions - Moose role for Catalyst-based site
4 exception handling
6 =cut
8 package SGN::Role::Site::Exceptions;
9 use Moose::Role;
10 use namespace::autoclean;
12 use List::MoreUtils qw/ any part /;
13 use Scalar::Util qw/ blessed /;
14 use Try::Tiny;
16 use SGN::Exception;
18 requires 'finalize_error', 'error', 'stash', 'view', 'res' ;
20 =head2 throw
22 Usage: $c->throw( public_message => 'There was a special error',
23 developer_message => 'the frob was not in place',
24 notify => 0,
26 Desc : creates and throws an L<SGN::Exception> with the given attributes.
27 Args : key => val to set in the new L<SGN::Exception>,
28 or if just a single argument is given, just calls die @_
29 Ret : nothing.
30 Side Effects: throws an exception
31 Example :
33 $c->throw('foo'); #equivalent to die 'foo';
35 $c->throw( title => 'Special Thing',
36 public_message => 'This is a very strange thing, you see ...',
37 developer_message => 'the froozle was 1, but fog was 0',
38 notify => 0, #< does not send an error email
39 is_server_error => 0, #< is not really an error, more of a message
40 is_client_error => 1, #< is not really an error, more of a message
43 =cut
45 sub throw {
46 my $self = shift;
47 if( @_ > 1 ) {
48 my %args = @_;
49 $args{public_message} ||= $args{message};
50 $args{message} ||= $args{public_message};
51 if( defined $args{is_error} && ! $args{is_error} ) {
52 $args{is_server_error} = 0;
53 $args{is_client_error} = 0;
55 my $exception = SGN::Exception->new( %args );
56 if( $exception->is_server_error ) {
57 die $exception;
58 } else {
59 $self->_set_exception_response( $exception );
60 $self->detach;
62 } else {
63 die @_;
67 =head1 throw_client_error
69 Usage: $c->throw_client_error(
70 public_message => 'There was a special error',
71 developer_message => 'the frob was not in place',
72 notify => 0,
74 Desc : creates and throws an L<SGN::Exception> with the given attributes.
75 Args : key => val to set in the new L<SGN::Exception>,
76 or if just a single argument is given, just calls die @_
77 Ret : nothing.
78 Side Effects: throws an exception and renders it for the client
79 Example :
81 $c->throw_client_error('foo');
83 #equivalent to $c->throw( public_message => 'foo', is_client_error => 1 );
85 =cut
87 sub throw_client_error {
88 my ($self,%args) = @_;
89 $self->throw( is_client_error => 1, %args);
92 =head2 throw_404
94 one arg, the context object.
96 Goes through some logic to figure out some things about the request,
97 then throws an exception that will display a 404 error page.
99 =cut
101 sub throw_404 {
102 my ( $c, $message ) = @_;
104 $message ||= 'Resource not found.';
105 $message .= '.' unless $message =~ /\.\s*$/; #< add a period at the end if the message does not have one
107 $c->log->debug("throwing 404 error ('$message')") if $c->debug;
109 my %throw = (
110 title => '404 - not found',
111 http_status => 404,
112 public_message => "$message We apologize for the inconvenience.",
115 # not sure if this logic works if we run under Ambikon
116 my $self_uri = $c->uri_for('/');
117 my $our_fault;
118 if (defined($c->req->referer())) {
119 $our_fault = $c->req->referer() =~ /$self_uri/;
121 if( $our_fault ) {
122 $throw{is_server_error} = 1;
123 $throw{is_client_error} = 0;
124 $throw{notify} = 0; # was 1 - but don't send these emails - too voluminous - and the above logic probably does not work correctly under Ambikon
125 $throw{developer_message} = "404 error seems to be our fault, referrer is '".$c->req->referer."'";
126 } else {
127 $throw{public_message} .= ' If you reached this page from a link on another site, you may wish to inform them that the link is incorrect.';
128 $throw{is_client_error} = 1;
129 $throw{is_server_error} = 0;
130 $throw{notify} = 0;
131 $throw{developer_message} = "404 is probably not our fault. Referrer is '".($c->req->referer || '')."'";
134 $c->log->debug( $throw{developer_message} ) if $c->debug;
136 $c->throw( %throw );
139 # convert all the errors to objects if they are not already
140 sub _error_objects {
141 my $self = shift;
143 return map $self->_coerce_to_exception( $_ ),
144 @{ $self->error };
147 sub _coerce_to_exception {
148 my ( $self, $thing ) = @_;
149 return $thing if blessed($thing) && $thing->isa('SGN::Exception');
150 return SGN::Exception->new( message => "$thing" );
154 sub _set_exception_response {
155 my $self = shift;
156 my @exceptions = map $self->_coerce_to_exception($_), @_;
158 # render the message page for all the errors
159 $self->stash({
160 template => '/site/error/exception.mas',
162 exception => \@exceptions,
163 show_dev_message => !$self->get_conf('production_server'),
166 $self->res->content_type('text/html');
168 unless( $self->view('Mason')->process( $self ) ) {
169 # there must have been an error in the message page, try a
170 # backup
171 $self->stash->{template} = '/site/error/500.mas';
172 unless( $self->view('Mason')->process( $self ) ) {
173 # whoo, really bad. set the body and status manually
174 $self->res->status(500);
175 $self->res->content_type('text/plain');
176 $self->res->body(
177 'Our apologies, a severe error has occurred. '
178 ."Please contact <a href=\"/contact/form\">this site's maintainers</a>"
179 . ' and report this error.'
184 # insert a JS pack in the error output if necessary
185 $self->forward('/insert_collected_html');
187 # set our http status to the most severe error we have
188 my ( $worst_status ) =
189 sort { $b <=> $a }
190 map $_->http_status,
191 @exceptions;
193 $self->res->status( $worst_status );
195 return 1;
198 around 'finalize_error' => sub {
199 my ( $orig, $self ) = @_;
201 $self->_set_exception_response( @{ $self->error } );
203 # now decide which errors to actually notify about, and notify about them
204 my ($no_notify, $notify) =
205 part { ($_->can('notify') && !$_->notify) ? 0 : 1 } $self->_error_objects;
206 $_ ||= [] for $no_notify, $notify;
208 if( @$notify && $self->config->{production_server} ) {
209 $self->stash->{email_errors} = $notify;
210 ####supress sgn-bugs emails#####
211 #try {
212 # $self->view('Email::ErrorEmail')->process( $self )
213 #} catch {
214 # $self->log->error("Failed to send error email! Error was: $_");
215 # push @{$self->error}, $_;
219 my @server_errors = grep $_->is_server_error, $self->_error_objects;
221 if( $self->debug && @server_errors && ! $self->config->{production_server} ) {
222 my $save_status = $self->res->status;
223 @{ $self->error } = @server_errors;
224 $self->$orig();
225 $self->res->status( $save_status ) if $save_status;
228 $self->clear_errors;