lib/SGN/Exception.pm

   1 =head1 NAME
   2
   3 SGN::Exception - expressive exception object for web applications
   4
   5 =head1 SYNOPSIS
   6
   7   die SGN::Exception->new(
   8
   9     title             => 'Froozle Error',
  10     public_message    => "Cannot process the froozle.",
  11     developer_message => "Froozle was '$froozle', path was '$fogbat_path'.",
  12
  13     http_status       => 406,
  14     is_server_error   => 1,
  15     is_client_error   => 0,
  16
  17     # developers need to be notified that this happened
  18     notify            => 1,
  19
  20   );
  21
  22 =head1 DESCRIPTION
  23
  24 The SGN::Exception object is meant to hold a wide variety of
  25 information about the nature of an exception or error condition.
  26 Nearly all the attributes of the exception object are optional.
  27
  28 =cut
  29
  30 package SGN::Exception;
  31 use Moose;
  32 use Scalar::Util ();
  33
  34 # make catalyst use this exception class
  35 { no warnings 'once';
  36   $Catalyst::Exception::CATALYST_EXCEPTION_CLASS = __PACKAGE__;
  37 }
  38
  39 with 'Catalyst::Exception::Basic';
  40
  41 use overload
  42   (
  43    q[""] => 'stringify',
  44    fallback => 1,
  45   );
  46
  47 =head1 ATTRIBUTES
  48
  49 All attributes are read-only.  None are required.
  50
  51 =head2 public_message
  52
  53 String, publicly-visible message for this error.  Should not reveal
  54 details that could have security implications.
  55
  56 =cut
  57
  58 has 'public_message' => (
  59     is  => 'ro',
  60     isa => 'Maybe[Str]',
  61    );
  62
  63 =head2 developer_message
  64
  65 String, private message for developers.  Should be included in error
  66 notifications sent to developers, debug backtraces, etc.
  67
  68 =cut
  69
  70 has 'developer_message' => (
  71     is  => 'ro',
  72     isa => 'Maybe[Str]',
  73    );
  74
  75 #TODO: redundant, deleteme
  76 has 'explanation' => (
  77     is  => 'ro',
  78     isa => 'Maybe[Str]',
  79    );
  80
  81 =head2 title
  82
  83 Optional string, user-visible title for the exception as presented to the user.
  84
  85 =cut
  86
  87 has 'title' => (
  88     is  => 'ro',
  89     isa => 'Maybe[Str]',
  90    );
  91
  92 =head2 is_server_error
  93
  94 Boolean, true if this error indicates a problem on the server side.
  95
  96 Defaults to true most of the time, but defaults to false if
  97 is_client_error is explicitly set to true.
  98
  99 =cut
 100
 101 has 'is_server_error' => (
 102     is  => 'ro',
 103     isa => 'Bool',
 104     default => 1,
 105 );
 106
 107 =head2 is_client_error
 108
 109 Boolean, true if this error indicates a problem on the client side.
 110
 111 Defaults to false most of the time, but default to true if
 112 is_server_error is set and false.
 113
 114 =cut
 115
 116 has 'is_client_error' => (
 117     is  => 'ro',
 118     isa => 'Bool',
 119     default => 0,
 120 );
 121
 122 =head2 http_status
 123
 124 Explicitly set the status code of the HTTP response for this error
 125 condition.
 126
 127 Defaults to 500 (Internal Server Error) if is_server_error is set,
 128 else 400 (Bad Request) if is_client_error is set, or 200 (OK) if
 129 is_client_error and is_server_error are both false.
 130
 131 =cut
 132
 133 has 'http_status' => (
 134     is  => 'ro',
 135     isa => 'Int',
 136     lazy_build => 1,
 137 );
 138 sub _build_http_status {
 139     my $self = shift;
 140     $self->is_server_error ? 500 :
 141     $self->is_client_error ? 400 :
 142                              200
 143 }
 144
 145 =head2 notify
 146
 147 Flag indicating whether developers should be actively notified that
 148 this exception occurred.
 149
 150 Boolean, defaults to true if is_server_error is set, false otherwise.
 151
 152 =cut
 153
 154 has 'notify' => (
 155     is  => 'ro',
 156     isa => 'Bool',
 157     lazy_build => 1,
 158    ); sub _build_notify {
 159        shift->is_server_error
 160    }
 161
 162 around 'BUILDARGS' => sub {
 163     my $orig  = shift;
 164     my $class = shift;
 165     my %args =  @_ > 1 ? @_ : ( message => @_ );
 166
 167     $args{developer_message} ||= $args{message};
 168     $args{message}           ||= $args{developer_message} || $args{public_message} || '(no message)';
 169
 170     if( defined $args{is_client_error} && !$args{is_client_error} ) {
 171         $args{is_server_error} = 1 unless defined $args{is_server_error};
 172     }
 173     if( defined $args{is_server_error} && !$args{is_server_error} ) {
 174         $args{is_client_error} = 1 unless defined $args{is_client_error};
 175     }
 176     if( $args{is_client_error} && ! defined $args{is_server_error} ) {
 177         $args{is_server_error} = 0;
 178     }
 179
 180     return $class->$orig( %args );
 181 };
 182
 183 =head1 METHODS
 184
 185 =head2 stringify
 186
 187 Return a plaintext string representation of this exception, suitable
 188 for display in consoles and so forth.
 189
 190 =cut
 191
 192 sub stringify {
 193     my $self = shift;
 194     return
 195         ($self->public_message || '') . "\n"
 196         .'Developer message: '
 197         .($self->developer_message || 'none');
 198 }
 199
 200 __PACKAGE__->meta->make_immutable;
 201 1;