Skip to content
Browse files

Merge branch 'release/1.3089_01'

  • Loading branch information...
2 parents a4f3aec + 69537e4 commit 04acd812c7c2021ce7d6d36b384f99c6a9bff1f8 @xsawyerx xsawyerx committed Nov 26, 2011
Showing with 1,123 additions and 338 deletions.
  1. +19 −0 CHANGES
  2. +10 −0 MANIFEST
  3. +1 −0 Makefile.PL
  4. +126 −28 lib/Dancer.pm
  5. +3 −2 lib/Dancer/App.pm
  6. +3 −2 lib/Dancer/Config.pm
  7. +16 −0 lib/Dancer/Continuation.pm
  8. +9 −0 lib/Dancer/Continuation/Halted.pm
  9. +17 −0 lib/Dancer/Continuation/Route.pm
  10. +9 −0 lib/Dancer/Continuation/Route/ErrorSent.pm
  11. +9 −0 lib/Dancer/Continuation/Route/FileSent.pm
  12. +9 −0 lib/Dancer/Continuation/Route/Forwarded.pm
  13. +9 −0 lib/Dancer/Continuation/Route/Passed.pm
  14. +9 −0 lib/Dancer/Continuation/Route/Templated.pm
  15. +6 −7 lib/Dancer/Cookbook.pod
  16. +4 −3 lib/Dancer/Deprecation.pm
  17. +3 −2 lib/Dancer/Engine.pm
  18. +12 −0 lib/Dancer/Error.pm
  19. +217 −151 lib/Dancer/Exception.pm
  20. +208 −0 lib/Dancer/Exception/Base.pm
  21. +6 −5 lib/Dancer/Factory/Hook.pm
  22. +3 −1 lib/Dancer/FileUtils.pm
  23. +22 −14 lib/Dancer/Handler.pm
  24. +5 −4 lib/Dancer/Handler/PSGI.pm
  25. +7 −0 lib/Dancer/Handler/Standalone.pm
  26. +13 −11 lib/Dancer/Hook.pm
  27. +3 −5 lib/Dancer/Logger/Abstract.pm
  28. +2 −1 lib/Dancer/Object.pm
  29. +3 −2 lib/Dancer/Object/Singleton.pm
  30. +5 −3 lib/Dancer/Plugin.pm
  31. +3 −1 lib/Dancer/Renderer.pm
  32. +5 −4 lib/Dancer/Request.pm
  33. +2 −1 lib/Dancer/Request/Upload.pm
  34. +1 −1 lib/Dancer/Response.pm
  35. +24 −3 lib/Dancer/Route.pm
  36. +3 −2 lib/Dancer/Route/Cache.pm
  37. +2 −1 lib/Dancer/Route/Registry.pm
  38. +2 −1 lib/Dancer/Serializer.pm
  39. +2 −1 lib/Dancer/Serializer/Dumper.pm
  40. +2 −1 lib/Dancer/Serializer/JSON.pm
  41. +2 −1 lib/Dancer/Serializer/YAML.pm
  42. +3 −2 lib/Dancer/Session/YAML.pm
  43. +3 −2 lib/Dancer/Template/Simple.pm
  44. +4 −3 lib/Dancer/Template/TemplateToolkit.pm
  45. +21 −5 lib/Dancer/Test.pm
  46. +12 −10 t/01_config/06_stack_trace.t
  47. +3 −1 t/03_route_handler/03_routes_api.t
  48. +6 −2 t/03_route_handler/15_prefix.t
  49. +4 −1 t/03_route_handler/34_forward_body_post.t
  50. +11 −1 t/06_helpers/01_send_file.t
  51. +2 −0 t/06_helpers/05_send_error.t
  52. +8 −1 t/07_apphandlers/04_standalone_app.t
  53. +2 −2 t/17_apps/02_load_app.t
  54. +13 −1 t/23_dancer_tests/02_tests_functions.t
  55. +66 −49 t/25_exceptions/01_exceptions.t
  56. +141 −0 t/25_exceptions/02_exceptions.t
  57. +8 −0 t/lib/TestApp.pm
View
19 CHANGES
@@ -1,3 +1,22 @@
+1.3089_01 26.11.2011
+
+ [ BUG FIXES ]
+ * Fix bug that made system() fail with -1 under Dancer (felixdo).
+ * Support for 'content_type' option on send_file when sending a
+ system wide file (Emmanuel Rodriguez).
+ * Support HTTP_X_FORWARDED_HOST in behing proxy (Ipaponov).
+ * Deserialize PATCH requests (Sam Kington).
+ * Encode log messages properly if charset UTF-8 is set (David Precious,
+ thanks to Penfold for the fix & MiklerGM for reporting).
+
+ [ ENHANCEMENTS ]
+ * Continuations-style exception system! (Damien Krotkine).
+ * The ability for dancer_response to send file contents for file uploads
+ as a scalar, instead of reading from file on disk (Squeeks).
+
+ [ DOCUMENTATION ]
+ * Clean up "plack_middlewares" example in docs (Richard Simões).
+
1.3080 25.10.2011
** Codename: Sawyer's Sugar Stream // Sawyer X **
View
10 MANIFEST
@@ -13,6 +13,14 @@ examples/dancr/views/show_entries.tt
lib/Dancer.pm
lib/Dancer/App.pm
lib/Dancer/Config.pm
+lib/Dancer/Continuation.pm
+lib/Dancer/Continuation/Halted.pm
+lib/Dancer/Continuation/Route.pm
+lib/Dancer/Continuation/Route/ErrorSent.pm
+lib/Dancer/Continuation/Route/FileSent.pm
+lib/Dancer/Continuation/Route/Forwarded.pm
+lib/Dancer/Continuation/Route/Passed.pm
+lib/Dancer/Continuation/Route/Templated.pm
lib/Dancer/Cookbook.pod
lib/Dancer/Cookie.pm
lib/Dancer/Cookies.pm
@@ -23,6 +31,7 @@ lib/Dancer/Development/Integration.pod
lib/Dancer/Engine.pm
lib/Dancer/Error.pm
lib/Dancer/Exception.pm
+lib/Dancer/Exception/Base.pm
lib/Dancer/Factory/Hook.pm
lib/Dancer/FileUtils.pm
lib/Dancer/GetOpt.pm
@@ -302,6 +311,7 @@ t/23_dancer_tests/01_basic.t
t/23_dancer_tests/02_tests_functions.t
t/24_deployment/01_multi_webapp.t
t/25_exceptions/01_exceptions.t
+t/25_exceptions/02_exceptions.t
t/25_exceptions/views/error.tt
t/25_exceptions/views/index.tt
t/25_exceptions/views/layouts/main.tt
View
1 Makefile.PL
@@ -47,6 +47,7 @@ WriteMakefile1(
'HTTP::Server::Simple::PSGI' => '0.11',
'MIME::Types' => '0',
'URI' => '1.59',
+ 'Try::Tiny' => '0.09',
# core
'File::Basename' => '0',
View
154 lib/Dancer.pm
@@ -5,7 +5,7 @@ use warnings;
use Carp;
use Cwd 'realpath';
-our $VERSION = '1.3080';
+our $VERSION = '1.3089_01';
our $AUTHORITY = 'SUKRIA';
use Dancer::App;
@@ -26,6 +26,14 @@ use Dancer::Session;
use Dancer::SharedData;
use Dancer::Handler;
use Dancer::MIME;
+use Dancer::Exception qw(:all);
+
+use Dancer::Continuation::Halted;
+use Dancer::Continuation::Route::Forwarded;
+use Dancer::Continuation::Route::Passed;
+use Dancer::Continuation::Route::ErrorSent;
+use Dancer::Continuation::Route::FileSent;
+use Dancer::Continuation::Route::Templated;
use File::Spec;
@@ -132,13 +140,19 @@ sub dirname { Dancer::FileUtils::dirname(@_) }
sub engine { Dancer::Engine->engine(@_) }
sub error { goto &Dancer::Logger::error }
sub false { 0 }
-sub forward { Dancer::SharedData->response->forward(@_) }
+sub forward { Dancer::SharedData->response->forward(@_);
+ # throw a special continuation exception
+ Dancer::Continuation::Route::Forwarded->new->throw;
+ }
sub from_dumper { Dancer::Serializer::Dumper::from_dumper(@_) }
sub from_json { Dancer::Serializer::JSON::from_json(@_) }
sub from_xml { Dancer::Serializer::XML::from_xml(@_) }
sub from_yaml { Dancer::Serializer::YAML::from_yaml(@_) }
sub get { map { my $r = $_; Dancer::App->current->registry->universal_add($r, @_) } qw(head get) }
-sub halt { Dancer::SharedData->response->halt(@_) }
+sub halt { Dancer::SharedData->response->halt(@_);
+ # throw a special continuation exception
+ Dancer::Continuation::Halted->new->throw;
+ }
sub header { goto &headers }
sub push_header { Dancer::SharedData->response->push_header(@_); }
sub headers { Dancer::SharedData->response->headers(@_); }
@@ -158,7 +172,10 @@ sub mime { Dancer::MIME->instance() }
sub options { Dancer::App->current->registry->universal_add('options', @_) }
sub params { Dancer::SharedData->request->params(@_) }
sub param { params->{$_[0]} }
-sub pass { Dancer::SharedData->response->pass(1) }
+sub pass { Dancer::SharedData->response->pass(1);
+ # throw a special continuation exception
+ Dancer::Continuation::Route::Passed->new->throw;
+ }
sub patch { Dancer::App->current->registry->universal_add('patch', @_) }
sub path { Dancer::FileUtils::path(@_) }
sub post { Dancer::App->current->registry->universal_add('post', @_) }
@@ -167,16 +184,26 @@ sub put { Dancer::App->current->registry->universal_add('put', @
sub redirect { goto &_redirect }
sub render_with_layout { Dancer::Template::Abstract->_render_with_layout(@_) }
sub request { Dancer::SharedData->request }
-sub send_error { Dancer::Error->new(message => $_[0], code => $_[1] || 500)->render() }
-sub send_file { goto &_send_file }
+sub send_error { Dancer::Continuation::Route::ErrorSent->new(
+ return_value => Dancer::Error->new(
+ message => $_[0],
+ code => $_[1] || 500)->render()
+ )->throw }
+#sub send_file { goto &_send_file }
+sub send_file { Dancer::Continuation::Route::FileSent->new(
+ return_value => _send_file(@_)
+ )->throw
+ }
sub set { goto &setting }
sub set_cookie { Dancer::Cookies->set_cookie(@_) }
sub setting { Dancer::App->applications ? Dancer::App->current->setting(@_) : Dancer::Config::setting(@_) }
sub session { goto &_session }
sub splat { @{ Dancer::SharedData->request->params->{splat} || [] } }
sub start { goto &_start }
sub status { Dancer::SharedData->response->status(@_) }
-sub template { Dancer::Template::Abstract->template(@_) }
+sub template { Dancer::Continuation::Route::Templated->new(
+ return_value => Dancer::Template::Abstract->template(@_)
+ )->throw }
sub to_dumper { Dancer::Serializer::Dumper::to_dumper(@_) }
sub to_json { Dancer::Serializer::JSON::to_json(@_) }
sub to_xml { Dancer::Serializer::XML::to_xml(@_) }
@@ -248,7 +275,7 @@ sub _load_app {
# load the application
_init_script_dir($script);
my ($res, $error) = Dancer::ModuleLoader->load($app_name);
- $res or croak "unable to load application $app_name : $error";
+ $res or raise core => "unable to load application $app_name : $error";
# restore the main application
Dancer::App->set_running_app('main');
@@ -304,7 +331,7 @@ sub _init_script_dir {
|| Dancer::FileUtils::path($appdir, 'views'));
my ($res, $error) = Dancer::ModuleLoader->use_lib(Dancer::FileUtils::path($appdir, 'lib'));
- $res or croak "unable to set libdir : $error";
+ $res or raise core => "unable to set libdir : $error";
}
@@ -327,7 +354,7 @@ sub _redirect {
sub _session {
engine 'session'
- or croak "Must specify session engine in settings prior to using 'session' keyword";
+ or raise core => "Must specify session engine in settings prior to using 'session' keyword";
@_ == 0 ? Dancer::Session->get
: @_ == 1 ? Dancer::Session->read(@_)
: Dancer::Session->write(@_);
@@ -342,8 +369,8 @@ sub _send_file {
# if you asked for streaming but it's not supported in PSGI
if ( $options{'streaming'} && ! $env->{'psgi.streaming'} ) {
- # TODO: throw a fit (AKA "exception") or a Dancer::Error (or croak)?
- croak 'Sorry, streaming is not supported on this server.';
+ # TODO: throw a fit (AKA "exception") or a Dancer::Error?
+ raise core => 'Sorry, streaming is not supported on this server.';
}
if (exists($options{content_type})) {
@@ -769,20 +796,21 @@ reached. If it was a B<GET>, it will remain a B<GET>.
Broader functionality might be added in the future.
-It is important to note that issuing a forward by itself does not exit and
-forward immediately, forwarding is deferred until after the current route
-or filter has been processed. To exit and forward immediately, use the return
-function, e.g.
+B<WARNING> : Issuing a forward immediately exits the current route,
+and perform the forward. Thus, any code after a forward is ignored, until the
+end of the route. e.g.
get '/some/path => sub {
if ($condition) {
- return forward '/articles/$article_id';
+ forward '/articles/$article_id';
+ # The following code is never executed
+ do_stuf();
}
more_stuff();
};
-You probably always want to use C<return> with forward.
+So it's not necessary anymore to use C<return> with forward.
Note that forward doesn't parse GET arguments. So, you can't use
something like:
@@ -840,14 +868,20 @@ renders the response immediately:
before sub {
if ($some_condition) {
- return halt("Unauthorized");
+ halt("Unauthorized");
+ # This code is not executed :
+ do_stuff();
}
};
get '/' => sub {
"hello there";
};
+B<WARNING> : Issuing a halt immediately exits the current route, and perform
+the halt. Thus, any code after a halt is ignored, until the end of the route.
+So it's not necessary anymore to use C<return> with halt.
+
=head2 headers
Adds custom headers to responses:
@@ -1056,6 +1090,26 @@ This hook receives as argument a L<Dancer::Response> object.
my $response = shift;
};
+=item on_handler_exception
+
+This hook is called when an exception has been caught, at the handler level,
+just before creating and rendering L<Dancer::Error>. This hook receives as
+argument a L<Dancer::Exception> object.
+
+ hook on_handler_exception => sub {
+ my $exception = shift;
+ };
+
+=item on_route_exception
+
+This hook is called when an exception has been caught, at the route level, just
+before rethrowing it higher. This hook receives the exception as argument. It
+can be a Dancer::Exception, or a string, or whatever was used to C<die>.
+
+ hook on_route_exception => sub {
+ my $exception = shift;
+ };
+
=back
=head2 layout
@@ -1145,12 +1199,16 @@ I<This method should be called from a route handler>.
Tells Dancer to pass the processing of the request to the next
matching route.
-You should always C<return> after calling C<pass>:
+B<WARNING> : Issuing a pass immediately exits the current route, and perform
+the pass. Thus, any code after a pass is ignored, until the end of the route.
+So it's not necessary anymore to use C<return> with pass.
get '/some/route' => sub {
if (...) {
# we want to let the next matching route handler process this one
- return pass();
+ pass(...);
+ # This code will be ignored
+ do_stuff();
}
};
@@ -1329,10 +1387,18 @@ Returns a HTTP error. By default the HTTP code returned is 500:
}
}
-This will not cause your route handler to return immediately, so be careful that
-your route handler doesn't then override the error. You can avoid that by
-saying C<return send_error(...)> instead.
+B<WARNING> : Issuing a send_error immediately exits the current route, and perform
+the send_error. Thus, any code after a send_error is ignored, until the end of the route.
+So it's not necessary anymore to use C<return> with send_error.
+ get '/some/route' => sub {
+ if (...) {
+ # we want to let the next matching route handler process this one
+ send_error(..);
+ # This code will be ignored
+ do_stuff();
+ }
+ };
=head2 send_file
@@ -1344,6 +1410,19 @@ the C<system_path> option (see below).
return send_file(params->{file});
}
+B<WARNING> : Issuing a send_file immediately exits the current route, and perform
+the send_file. Thus, any code after a send_file is ignored, until the end of the route.
+So it's not necessary anymore to use C<return> with send_file.
+
+ get '/some/route' => sub {
+ if (...) {
+ # we want to let the next matching route handler process this one
+ send_file(...);
+ # This code will be ignored
+ do_stuff();
+ }
+ };
+
Send file supports streaming possibility using PSGI streaming. The server should
support it but normal streaming is supported on most, if not all.
@@ -1615,6 +1694,20 @@ Tells the route handler to build a response with the current template engine:
template 'some_view', { token => 'value'};
};
+B<WARNING> : Issuing a template immediately exits the current route, and perform
+the template. Thus, any code after a template is ignored, until the end of the route.
+So it's not necessary anymore to use C<return> with template.
+
+ get '/some/route' => sub {
+ if (...) {
+ # we want to let the next matching route handler process this one
+ template(...);
+ # This code will be ignored
+ do_stuff();
+ }
+ };
+
+
The first parameter should be a template available in the views directory, the
second one (optional) is a HashRef of tokens to interpolate, and the third
(again optional) is a HashRef of options.
@@ -1727,19 +1820,24 @@ versions:
=head2 var
-Defines a variable shared between filters and route handlers.
+Provides an accessor for variables shared between filters and route handlers.
+Given a key/value pair, it sets a variable:
before sub {
var foo => 42;
};
-Route handlers and other filters will be able to read that variable with the
-C<vars> keyword.
+Later, route handlers and other filters will be able to read that variable:
+
+ get '/path' => sub {
+ my $foo = var 'foo';
+ ...
+ };
=head2 vars
Returns the HashRef of all shared variables set during the filter/route
-chain:
+chain with the C<var> keyword:
get '/path' => sub {
if (vars->{foo} eq 42) {
View
5 lib/Dancer/App.pm
@@ -9,6 +9,7 @@ use Dancer::Config;
use Dancer::ModuleLoader;
use Dancer::Route::Registry;
use Dancer::Logger;
+use Dancer::Exception qw(:all);
Dancer::App->attributes(qw(name app_prefix prefix registry settings on_lexical_prefix));
@@ -39,7 +40,7 @@ sub set_prefix {
undef $prefix if defined($prefix) and $prefix eq "/";
- croak "not a valid prefix: `$prefix', must start with a /"
+ raise core_app => "not a valid prefix: `$prefix', must start with a /"
if defined($prefix) && $prefix !~ /^\//;
my $app_prefix = defined $self->app_prefix ? $self->app_prefix : "";
@@ -155,7 +156,7 @@ sub init {
my ($self) = @_;
$self->name('main') unless defined $self->name;
- croak "an app named '" . $self->name . "' already exists"
+ raise core_app => "an app named '" . $self->name . "' already exists"
if exists $_apps->{$self->name};
# default values for properties
View
5 lib/Dancer/Config.pm
@@ -10,6 +10,7 @@ use Dancer::Template;
use Dancer::ModuleLoader;
use Dancer::FileUtils 'path';
use Carp;
+use Dancer::Exception qw(:all);
use Encode;
@@ -72,7 +73,7 @@ my $setters = {
},
traces => sub {
my ($setting, $traces) = @_;
- $Carp::Verbose = $traces ? 1 : 0;
+ $Dancer::Exception::Verbose = $traces ? 1 : 0;
},
};
$setters->{log_path} = $setters->{log_file};
@@ -84,7 +85,7 @@ my $normalizers = {
or return $charset;
my $encoding = Encode::find_encoding($charset);
defined $encoding
- or croak "Charset defined in configuration is wrong : couldn't identify '$charset'";
+ or raise core_config => "Charset defined in configuration is wrong : couldn't identify '$charset'";
my $name = $encoding->name;
# Perl makes a distinction between the usual perl utf8, and the strict
# utf8 charset. But we don't want to make this distinction
View
16 lib/Dancer/Continuation.pm
@@ -0,0 +1,16 @@
+package Dancer::Continuation;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+ my $class = shift;
+ bless { @_ }, $class;
+}
+
+sub throw { die shift }
+
+sub rethrow { die shift }
+
+1;
View
9 lib/Dancer/Continuation/Halted.pm
@@ -0,0 +1,9 @@
+package Dancer::Continuation::Halted;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation);
+
+1;
View
17 lib/Dancer/Continuation/Route.pm
@@ -0,0 +1,17 @@
+package Dancer::Continuation::Route;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation);
+
+# A Dancer::Continuation::Route is a continuation exception, that is caught as
+# route execution level (see Dancer::Route::run). It may store a return_value, that
+# will be recovered from the continuation catcher, and stored as the returning
+# content.
+
+sub return_value { $#_ ? $_[0]->{return_value} = $_[1] : $_[0]->{return_value} }
+
+
+1;
View
9 lib/Dancer/Continuation/Route/ErrorSent.pm
@@ -0,0 +1,9 @@
+package Dancer::Continuation::Route::ErrorSent;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation::Route);
+
+1;
View
9 lib/Dancer/Continuation/Route/FileSent.pm
@@ -0,0 +1,9 @@
+package Dancer::Continuation::Route::FileSent;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation::Route);
+
+1;
View
9 lib/Dancer/Continuation/Route/Forwarded.pm
@@ -0,0 +1,9 @@
+package Dancer::Continuation::Route::Forwarded;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation::Route);
+
+1;
View
9 lib/Dancer/Continuation/Route/Passed.pm
@@ -0,0 +1,9 @@
+package Dancer::Continuation::Route::Passed;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation::Route);
+
+1;
View
9 lib/Dancer/Continuation/Route/Templated.pm
@@ -0,0 +1,9 @@
+package Dancer::Continuation::Route::Templated;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Dancer::Continuation::Route);
+
+1;
View
13 lib/Dancer/Cookbook.pod
@@ -879,7 +879,7 @@ For instance, if you want to enable L<Plack::Middleware::Debug> in your Dancer
application, all you have to do is to set C<plack_middlewares> like that:
set plack_middlewares => [
- [ 'Debug' => [ 'panels' => qw(DBITrace Memory Timer) ]],
+ [ 'Debug' => [ 'panels' => [qw(DBITrace Memory Timer)] ] ],
];
Of course, you can also put this configuration into your config.yml file, or
@@ -890,11 +890,12 @@ even in your environment configuration files:
plack_middlewares:
-
- Debug # first element of the array is the name of the middleware
- - panels # following elements are the configuration ofthe middleware
-
- - DBITrace
- - Memory
- - Timer
+ - panels # following elements are the configuration ofthe middleware
+ -
+ - DBITrace
+ - Memory
+ - Timer
=head3 Path-based middlewares
@@ -908,5 +909,3 @@ C<plack_middlewares_map>. You'll need L<Plack::App::URLMap> to do that.
=head1 AUTHORS
Dancer contributors - see AUTHORS file.
-
-
View
7 lib/Dancer/Deprecation.pm
@@ -2,7 +2,8 @@ package Dancer::Deprecation;
use strict;
use warnings;
-use Carp qw/croak carp/;
+use Carp;
+use Dancer::Exception qw(:all);
sub deprecated {
my ($class, %args) = @_;
@@ -25,7 +26,7 @@ sub deprecated {
$msg .= " since version $deprecated_at" if defined $deprecated_at;
$msg .= ". " . $args{reason} if defined $args{reason};
- croak($msg) if $args{fatal};
+ raise core_deprecation => $msg if $args{fatal};
carp($msg);
}
@@ -59,7 +60,7 @@ List of possible parameters:
=item B<message> message to display
-=item B<fatal> if set to true, croak instead of carp
+=item B<fatal> if set to true, raises a Dancer::Exception (Core::Deprecation) instead of carp
=item B<reason> why is the feature deprecated
View
5 lib/Dancer/Engine.pm
@@ -9,6 +9,7 @@ use warnings;
use Carp;
use Dancer::ModuleLoader;
use base 'Dancer::Object';
+use Dancer::Exception qw(:all);
# constructor arguments:
# name => $name_of_the_engine
@@ -30,7 +31,7 @@ sub config {
sub build {
my ($class, $type, $name, $config) = @_;
- croak "cannot build engine without type and name "
+ raise core_engine => "cannot build engine without type and name "
unless $name and $type;
my $class_name = $class->_engine_class($type);
@@ -43,7 +44,7 @@ sub build {
my $engine_class =
Dancer::ModuleLoader->class_from_setting($class_name => $name);
- croak "unknown $type engine '$name', "
+ raise core_engine => "unknown $type engine '$name', "
. "perhaps you need to install $engine_class?"
unless Dancer::ModuleLoader->load($engine_class);
View
12 lib/Dancer/Error.pm
@@ -328,6 +328,14 @@ The message of the error page.
This is only an attribute getter, you'll have to set it at C<new>.
+=head2 exception
+
+The exception that caused the error. If the error was not caused by an
+exception, returns undef. Exceptions are usually objects that inherits of
+Dancer::Exception.
+
+This is only an attribute getter, you'll have to set it at C<new>.
+
=head1 METHODS/SUBROUTINES
=head2 new
@@ -350,6 +358,10 @@ The code that caused the error.
The message that will appear to the user.
+=head3 exception
+
+The exception that will be useable by the rendering.
+
=head2 backtrace
Create a backtrace of the code where the error is caused.
View
368 lib/Dancer/Exception.pm
@@ -4,207 +4,273 @@ use strict;
use warnings;
use Carp;
+our $Verbose = 0;
+
+use Dancer::Exception::Base;
+
use base qw(Exporter);
-my @exceptions = qw(E_HALTED E_GENERIC);
-our @EXPORT_OK = (@exceptions, qw(raise list_exceptions is_dancer_exception register_custom_exception));
-our %value_to_custom_name;
-our %custom_name_to_value;
-our %EXPORT_TAGS = ( exceptions => [ @exceptions],
- internal_exceptions => [ @exceptions],
- custom_exceptions => [],
- utils => => [ qw(raise list_exceptions is_dancer_exception register_custom_exception) ],
- all => \@EXPORT_OK,
- );
+our @EXPORT_OK = (qw(try catch continuation register_exception registered_exceptions raise));
+our %EXPORT_TAGS = ( all => \@EXPORT_OK );
+use Try::Tiny ();
-=head1 SYNOPSIS
+sub try (&;@) {
+ goto &Try::Tiny::try;
+}
- use Dancer::Exception qw(:all);
+sub catch (&;@) {
+ my ( $block, @rest ) = @_;
+
+ my $continuation_code;
+ my @new_rest = grep { ref ne 'Try::Tiny::Catch' or $continuation_code = $$_, 0 } @rest;
+ $continuation_code
+ and return ( bless( \ sub {
+ ref && $_->isa('Dancer::Continuation')
+ ? $continuation_code->(@_) : $block->(@_);
+ }, 'Try::Tiny::Catch') , @new_rest);
+
+ return ( bless ( \ sub {
+ ref && $_->isa('Dancer::Continuation')
+ ? die($_) : $block->(@_) ;
+ }, 'Try::Tiny::Catch'), @new_rest );
+}
+
+sub continuation (&;@) {
+ my ( $block, @rest ) = @_;
+
+ my $catch_code;
+ my @new_rest = grep { ref ne 'Try::Tiny::Catch' or $catch_code = $$_, 0 } @rest;
+ $catch_code
+ and return ( bless( \ sub {
+ ref && $_->isa('Dancer::Continuation')
+ ? $block->(@_) : $catch_code->(@_);
+ }, 'Try::Tiny::Catch') , @new_rest);
+
+ return ( bless ( \ sub {
+ ref && $_->isa('Dancer::Continuation')
+ ? $block->(@_) : die($_);
+ }, 'Try::Tiny::Catch'), @new_rest );
+}
- # raise an exception
- raise E_HALTED;
+sub raise ($;@) {
+ my $exception_name = shift;
+ my $exception;
+ if ($exception_name =~ s/^\+//) {
+ $exception = $exception_name->new(@_);
+ } else {
+ _camelize($exception_name);
+ $exception = "Dancer::Exception::$exception_name"->new(@_);
+ }
+ $exception->throw();
+}
- # get a list of possible exceptions
- my @exception_names = list_exceptions;
+sub _camelize {
+ # using aliasing for ease of use
+ $_[0] =~ s/^(.)/uc($1)/e;
+ $_[0] =~ s/_(.)/'::' . uc($1)/eg;
+}
- # catch an exception
- eval { ... };
- if ( my $value = is_dancer_exception(my $exception = $@) ) {
- if ($value == ( E_HALTED | E_FOO ) ) {
- # it's a halt or foo exception...
+sub register_exception {
+ my ($exception_name, %params) = @_;
+ my $exception_class = 'Dancer::Exception::' . $exception_name;
+ my $path = $exception_class; $path =~ s|::|/|g; $path .= '.pm';
+
+ if (exists $INC{$path}) {
+ local $Carp::CarpLevel = $Carp::CarpLevel++;
+ 'Dancer::Exception::Base::Internal'
+ ->new("register_exception failed: $exception_name is already defined")
+ ->throw;
}
- } elsif ($exception) {
- # do something with $exception (don't use $@ as it may have been reset)
- }
-=head1 DESCRIPTION
+ my $message_pattern = $params{message_pattern};
+ my $composed_from = $params{composed_from};
+ my @composition = map { 'Dancer::Exception::' . $_ } @$composed_from;
-This is a lighweight exceptions module. Yes, it's not Object Oriented, that's
-on purpose, to keep it light and fast. Thus, you can use ref() instead of
-->isa(), and exceptions have no method to call on. Simply dereference them to
-get their value
+ $INC{$path} = __FILE__;
+ eval "\@${exception_class}::ISA=qw(Dancer::Exception::Base " . join (' ', @composition) . ');';
+
+ if (defined $message_pattern) {
+ no strict 'refs';
+ *{"${exception_class}::_message_pattern"} = sub { $message_pattern };
+ }
-An exception is a blessed reference on an integer. This integer is always a
-power of two, so that you can test its value using the C<|> operator. A Dancer
-exception is always blessed as C<'Dancer::Exception'>.
+}
-=head1 EXPORTS
+sub registered_exceptions {
+ sort map { s|/|::|g; s/\.pm$//; $_ } grep { s|^Dancer/Exception/||; } keys %INC;
+}
-to be able to use this module, you should use it with these options :
+register_exception(@$_) foreach (
+ [ 'Core', message_pattern => 'core - %s' ],
+ [ 'Core::App', message_pattern => 'app - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Config', message_pattern => 'config - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Deprecation', message_pattern => 'deprecation - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Engine', message_pattern => 'engine - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Factory', message_pattern => 'factory - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Factory::Hook', message_pattern => 'hook - %s', composed_from => [ qw(Core::Factory) ] ],
+ [ 'Core::Hook', message_pattern => 'hook - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Fileutils', message_pattern => 'file utils - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Handler', message_pattern => 'handler - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Handler::PSGI', message_pattern => 'handler - %s', composed_from => [ qw(Core::Handler) ] ],
+ [ 'Core::Plugin', message_pattern => 'plugin - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Renderer', message_pattern => 'renderer - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Route', message_pattern => 'route - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Serializer', message_pattern => 'serializer - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Template', message_pattern => 'template - %s', composed_from => [ qw(Core) ] ],
+ [ 'Core::Session', message_pattern => 'session - %s', composed_from => [ qw(Core) ] ],
+);
- # loads specific exceptions only. See list_exceptions for a list
- use Dancer::Exception qw(E_HALTED E_PLOP);
+1;
- # loads the utility functions
- use Dancer::Exception qw(raise list_exceptions is_dancer_exception register_custom_exception);
+__END__
- # this does the same thing as above
- use Dancer::Exception qw(:utils);
+=pod
- # loads all exception names, but not the utils
- use Dancer::Exception qw(:exceptions);
+=head1 NAME
- # loads only the internal exception names
- use Dancer::Exception qw(:internal_exceptions);
+Dancer::Exception - class for throwing and catching exceptions
- # loads only the custom exception names
- use Dancer::Exception qw(:custom_exceptions);
+=head1 SYNOPSIS
- # loads everything
- use Dancer::Exception qw(:all);
+ use Dancer::Exception qw(:all);
-=head1 FUNCTIONS
+ register_exception('DataProblem',
+ message_pattern => "test message : %s"
+ );
-=head2 raise
+ sub do_stuff {
+ raise DataProblem => "we've lost data!";
+ }
- raise E_HALTED;
+ try {
+ do_stuff()
+ } catch {
+ # an exception was thrown
+ my ($exception) = @_;
+ if ($exception->does('DataProblem')) {
+ # handle the data problem
+ my $message = $exception->message();
+ } else {
+ $exception->rethrow
+ }
+ };
-Used to raise an exception. Takes in argument an integer (must be a power of
-2). You should give it an existing Dancer exception.
-=cut
-# yes we use __CLASS__, it's not OO and inheritance proof, but if you'd pay
-# attention, you'd have noticed that this module is *not* a class :)
-sub raise { die bless \ do { my $e = $_[0] }, __PACKAGE__ }
+=head1 DESCRIPTION
-=head2 list_exceptions
+Dancer::Exception is based on L<Try::Tiny>. You can try and catch exceptions,
+like in L<Try::Tiny>.
- my @exception_names = list_exceptions;
- my @exception_names = list_exceptions(type => 'internal');
- my @exception_names = list_exceptions(type => 'custom');
+Exceptions are objects, from subclasses of L<Dancer::Exception::Base>.
-Returns a list of strings, the names of available exceptions.
+However, for internal Dancer usage, we introduce a special class of exceptions,
+called L<Dancer::Continuation>. Exceptions that are from this class are not
+caught with a C<catch> block, but only with a C<continuation>. That's a cheap
+way to implement a I<workflow interruption>. Dancer users should ignore this
+feature.
-Parameters are an optional list of key values. Accepted keys are for now only
-C<type>, to restrict the list of exceptions on the type of the Dancer
-exception. C<type> can be 'internal' or 'custom'.
+=head2 What it means for Dancer users
-=cut
+Users can throw and catch exceptions, using C<try> and C<catch>. They can reuse
+some Dancer core exceptions (C<Dancer::Exception::Base::*>), but they can also
+create new exception classes, and use them for their own means. That way it's
+easy to use custom exceptions in a Dancer application. Have a look at
+C<register_exception>, C<raise>, and the methods in L<Dancer::Exception::Base>.
-sub list_exceptions {
- my %params = @_;
- ( $params{type} || '' ) eq 'internal'
- and return @exceptions;
- ( $params{type} || '' ) eq 'custom'
- and return keys %custom_name_to_value;
- return @exceptions, keys %custom_name_to_value;
-}
+=head1 METHODS
-=head2 is_dancer_internal_exception
-
- # test if it's a Dancer exception
- my $value = is_dancer_exception($@);
- # test if it's a Dancer internal exception
- my $value = is_dancer_exception($@, type => 'internal');
- # test if it's a Dancer custom exception
- my $value = is_dancer_exception($@, type => 'custom');
-
-This function tests if an exception is a Dancer exception, and if yes get its
-value. If not, it returns void
-
-First parameter is the exception to test. Other parameters are an optional list
-of key values. Accepted keys are for now only C<type>, to restrict the test on
-the type of the Dancer exception. C<type> can be 'internal' or 'custom'.
-
-Returns the exception value (which is always true), or void (empty list) if the
-exception was not a dancer exception (of the right type if specified).
-
-=cut
-
-sub is_dancer_exception {
- my ($exception, %params) = @_;
- ref $exception eq __PACKAGE__
- or return 0;
- my $value = $$exception;
- @_ > 1
- or return $value;
- $params{type} eq 'internal' && $value < 2**16
- and return $value;
- $params{type} eq 'custom' && $value >= 2**16
- and return $value;
- return 0;
-}
+=head2 try
-=head2 register_custom_exception
+Same as in L<Try::Tiny>
- register_custom_exception('E_FROBNICATOR');
- # now I can use this exception for raising
- raise E_FROBNICATOR;
+=head2 catch
+Same as in L<Try::Tiny>. The exception can be retrieved as the first parameter:
-=cut
+ try { ... } catch { my ($exception) = @_; };
-sub register_custom_exception {
- my ($exception_name, %params) = @_;
- exists $value_to_custom_name{$exception_name}
- and croak "can't register '$exception_name' custom exception, it already exists";
- keys %value_to_custom_name < 16
- or croak "can't register '$exception_name' custom exception, all 16 custom slots are registered";
- my $value = 2**16;
- while($value_to_custom_name{$value}) { $value*=2; }
- $value_to_custom_name{$value} = $exception_name;
- $custom_name_to_value{$exception_name} = $value;
-
- my $pkg = __PACKAGE__;
- no strict 'refs';
- *{"$pkg\::$exception_name"} = sub { $value };
-
- push @EXPORT_OK, $exception_name;
- push @{$EXPORT_TAGS{custom_exceptions}}, $exception_name;
- $params{no_import}
- or $pkg->export_to_level(1, $pkg, $exception_name);
-
- return;
-}
+=head2 continuation
+To be used by Dancer developers only, in Dancer core code.
-=head1 INTERNAL EXCEPTIONS
+=head2 raise
-=head2 E_GENERIC
+ # raise Dancer::Exception::Base::Custom
+ raise Custom => "user $username is unknown";
-A generic purpose exception. Not used by internal code, so this exception can
-be used by user code safely, without having to register a custom user exception.
+ # raise Dancer::Exception::Base::Custom::Frontend
+ raise 'Custom::Frontend' => "user $username is unknown";
-=cut
+ # same, raise Dancer::Exception::Base::Custom::Frontend
+ raise custom_frontend => "user $username is unknown";
-sub E_GENERIC () { 1 }
+ # raise My::Own::ExceptionSystem::Invalid::Login
+ raise '+My::Own::ExceptionSystem::Invalid::Login' => "user $username is unknown";
-=head2 E_HALTED
+raise provides an easy way to throw an exception. First parameter is the name
+of the exception class, without the C<Dancer::Exception::Base::> prefix. other
+parameters are stored as I<raising arguments> in the exception. Usually the
+parameters is an exception message, but it's left to the exception class
+implementation.
-Internal exception, generated when C<halt()> is called (see in L<Dancer> POD).
+If the exception class name starts with a C<+>, then the
+C<Dancer::Exception::Base::> won't be added. This allows to build their own
+exception class hierarchy, but you should first look at C<register_exception>
+before implementing your own class hierarchy. If you really wish to build your
+own exception class hierarchy, we recommend that all exceptions inherit of
+L<Dancer::Exception::Base>. Or at least it should implement its methods.
-=cut
+The exception class can also be written as words separated by underscores, it'll be
+camelized automatically. So C<'Exception::Foo'> and C<'exception_foo'> are
+equivalent. Be careful, C<'MyException'> can't be written C<'myexception'>, as
+it would be camelized into C<'Myexception'>.
-sub E_HALTED () { 2 }
+=head2 register_exception
-=head1 CUSTOM EXCEPTIONS
+This method allows to register custom exceptions, usable by Dancer users in
+their route code (actually pretty much everywhere).
-In addition to internal (and the generic one) exception, users have the ability
-to register more Dancer exceptions for their need. To do that, see
-C<register_custom_exception>.
+ # simple exception
+ register_exception ('InvalidCredentials',
+ message_pattern => "invalid credentials : %s",
+ );
-=cut
+This registers a new custom exception. To use it, do:
-1;
+ raise InvalidCredentials => "user Herbert not found";
+
+The exception message can be retrieved with the C<$exception->message> method, and we'll be
+C<"invalid credentials : user Herbert not found"> (see methods in L<Dancer::Exception::Base>)
+
+ # complex exception
+ register_exception ('InvalidLogin',
+ composed_from => [qw(Fatal InvalidCredentials)],
+ message_pattern => "wrong login or password",
+ );
+
+In this example, the C<InvalidLogin> is built as a composition of the C<Fatal>
+and C<InvalidCredentials> exceptions. See the C<does> method in
+L<Dancer::Exception::Base>.
+
+=head2 registered_exceptions
+
+ my @exception_classes = registered_exceptions;
+
+Returns the list of exception class names. It will list core exceptions C<and>
+custom exceptions (except the one you've registered with a leading C<+>, see
+C<register_exception>). The list is sorted.
+
+=head1 GLOBAL VARIABLE
+
+=head2 $Dancer::Exception::Verbose
+
+When set to 1, exceptions will stringify with a long stack trace. This variable
+is similar to C<$Carp::Verbose>. I recommend you use it like that:
+
+ local $Dancer::Exception::Verbose;
+ $Dancer::Exception::Verbose = 1;
+
+All the L<Carp> global variables can also be used to alter the stacktrace
+generation.
View
208 lib/Dancer/Exception/Base.pm
@@ -0,0 +1,208 @@
+package Dancer::Exception::Base;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Exporter);
+
+use Dancer::Exception;
+
+use overload '""' => sub {
+ my ($self) = @_;
+ $self->message
+ . ( $Dancer::Exception::Verbose ? $self->{_longmess} : $self->{_shortmess});
+};
+
+# string comparison is done without the stack traces
+use overload 'cmp' => sub {
+ my ($e, $f) = @_;
+ ( ref $e && $e->isa(__PACKAGE__)
+ ? $e->message : $e )
+ cmp
+ ( ref $f && $f->isa(__PACKAGE__)
+ ? $f->message : $f )
+};
+
+# This is the base class of all exceptions
+
+sub new {
+ my $class = shift;
+ my $self = bless { _raised_arguments => [],
+ _shortmess => '',
+ _longmess => '',
+ }, $class;
+ $self->_raised_arguments(@_);
+ return $self;
+}
+
+# base class has a passthrough message
+sub _message_pattern { '%s' }
+
+sub throw {
+ my $self = shift;
+ $self->_raised_arguments(@_);
+ local $Carp::CarpInternal;
+ local $Carp::Internal;
+ $Carp::Internal{'Dancer'} ++;
+ $Carp::CarpInternal{'Dancer::Exception'} ++;
+ $self->{_shortmess} = Carp::shortmess;
+ $self->{_longmess} = Carp::longmess;
+ die $self;
+}
+
+sub rethrow { die $_[0] }
+
+sub message {
+ my ($self) = @_;
+ my $message_pattern = $self->_message_pattern;
+ my $message = sprintf($message_pattern, @{$self->_raised_arguments});
+ my @composition = (reverse $self->get_composition);
+ shift @composition;
+ foreach my $component (@composition) {
+ my $class = "Dancer::Exception::$component";
+ no strict 'refs';
+ my $pattern = $class->_message_pattern;
+ $message = sprintf($pattern, $message);
+ }
+ return $message;
+}
+
+sub does {
+ my $self = shift;
+ my $regexp = join('|', map { '^' . $_ . '$'; } @_);
+ (scalar grep { /$regexp/ } $self->get_composition) >= 1;
+}
+
+sub get_composition {
+ my ($self) = @_;
+ my $class = ref($self);
+ my @isa = do { no strict 'refs'; @{"${class}::ISA"}, $class };
+ return grep { s|^Dancer::Exception::|| } @isa;
+}
+
+sub _raised_arguments {
+ my $self = shift;
+ @_ and $self->{_raised_arguments} = [ @_ ];
+ $self->{_raised_arguments};
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Dancer::Exception::Base - the base class of all Dancer exceptions
+
+=head1 DESCRIPTION
+
+Dancer::Exception::Base is the base class of all Dancer exception. All core
+exceptions, and all custom exception registered using
+C<Dancer::Exception::register_exception> inherits of
+C<Dancer::Exception::Base>.
+
+=head1 METHODS
+
+=head2 throw
+
+Throws an exception. It's what C<raise> (from L<Dancer::Exception>) uses. Any
+arguments is set as raising parameters. You should not use this method
+directly, but instead, use C<raise> from L<Dancer::Exception>.
+
+B<Warning>, if you want to rethrow an exception, use C<rethrow>.
+
+=head2 rethrow
+
+Re-throw the exception, without touching its parameters. Useful if you've
+caught and exception but don't want to handle it, and want to rethrow it.
+
+ try { ... }
+ catch {
+ my ($e) = @_;
+ $e->does('InvalidLogin')
+ or $e->rethrow;
+ ...
+ };
+
+=head2 does
+
+Given an exception type, returns true if the exception is of the same type.
+
+ try { raise InvalidLogin => 'foo'; }
+ catch {
+ my ($e) = @_;
+ $e->does('InvalidLogin') # true
+ ...
+ };
+
+It can receive more than one type, useful for composed exception, or checking
+multiple types at once. C<does> performs a logical OR between them:
+
+ try { raise InvalidPassword => 'foo'; }
+ catch {
+ my ($e) = @_;
+ $e->does('InvalidLogin', 'InvalidPassword') # true
+ ...
+ };
+
+=head2 get_composition
+
+Returns the type or the composed types of an exception.
+B<Warning>, the result is a list, so you should call this method in list context.
+
+ try { raise InvalidPassword => 'foo'; }
+ catch {
+ my ($e) = @_;
+ my @list = $e->get_composition()
+ # @list contains ( 'InvalidPassword' )
+ };
+
+=head2 message
+
+Computes and returns the message associated to the exception. It'll apply the
+parameters that were set at throw time to the message patterns of all the class
+that composes the exception.
+
+=head1 STRINGIFICATION
+
+=head2 string overloading
+
+All Dancer exceptions properly stringify. When evaluated to a string, they
+return their message, concatenated with their stack trace (see below).
+
+=head2 cmp overloading
+
+The C<cmp> operator is also overloaded, thus all the string operations can be
+done on Dancer's exceptions, as they will all be based on the overloaded C<cmp>
+operator. Dancer exceptions wil be compared B<without> their stacktraces.
+
+=head1 STACKTRACE
+
+Similarly to L<Carp>, Dancer exceptions stringification appends a string
+stacktrace to the exception message.
+
+The stacktrace can be a short one, or a long one. Actually the implementation
+internally uses L<Carp>.
+
+To enable long stack trace (for debugging purpose), you can use the global
+variable C<Dancer::Exception::Verbose> (see below).
+
+The short and long stacktrace snippets are stored within C<$self->{_shortmess}>
+and C<$self->{_longmess}>. Don't touch them or rely on them, they are
+internals, and will change soon.
+
+=head1 GLOBAL VARIABLE
+
+=head2 $Dancer::Exception::Verbose
+
+When set to 1, exceptions will stringify with a long stack trace. This variable
+is similar to C<$Carp::Verbose>. I recommend you use it like that:
+
+ local $Dancer::Exception::Verbose;
+ $Dancer::Exception::Verbose = 1;
+
+All the L<Carp> global variables can also be used to alter the stacktrace
+generation.
View
11 lib/Dancer/Factory/Hook.pm
@@ -5,6 +5,7 @@ use warnings;
use Carp;
use base 'Dancer::Object::Singleton';
+use Dancer::Exception qw(:all);
__PACKAGE__->attributes(qw/ hooks registered_hooks/);
@@ -19,12 +20,12 @@ sub install_hooks {
my ( $self, @hooks_name ) = @_;
if ( !scalar @hooks_name ) {
- croak "at least one name is required";
+ raise core_factory_hook => "at least one name is required";
}
foreach my $hook_name (@hooks_name) {
if ( $self->hook_is_registered($hook_name) ) {
- croak "$hook_name is already regsitered, please use another name";
+ raise core_factory_hook => "$hook_name is already regsitered, please use another name";
}
$self->_add_hook( $hook_name );
}
@@ -53,10 +54,10 @@ sub hook_is_registered {
sub execute_hooks {
my ($self, $hook_name, @args) = @_;
- croak("Can't ask for hooks without a position") unless $hook_name;
+ raise core_factory_hook => "Can't ask for hooks without a position" unless $hook_name;
if (!$self->hook_is_registered($hook_name)){
- croak("The hook '$hook_name' doesn't exists");
+ raise core_factory_hook => "The hook '$hook_name' doesn't exists";
}
foreach my $h (@{$self->get_hooks_for($hook_name)}) {
@@ -67,7 +68,7 @@ sub execute_hooks {
sub get_hooks_for {
my ( $self, $hook_name ) = @_;
- croak("Can't ask for hooks without a position") unless $hook_name;
+ raise core_factory_hook => "Can't ask for hooks without a position" unless $hook_name;
$self->hooks->{$hook_name} || [];
}
View
4 lib/Dancer/FileUtils.pm
@@ -8,6 +8,8 @@ use File::Spec;
use Carp;
use Cwd 'realpath';
+use Dancer::Exception qw(:all);
+
use base 'Exporter';
use vars '@EXPORT_OK';
@@ -65,7 +67,7 @@ sub open_file {
my ( $mode, $filename ) = @_;
open my $fh, $mode, $filename
- or croak "$! while opening '$filename' using mode '$mode'";
+ or raise core_fileutils => "$! while opening '$filename' using mode '$mode'";
return set_file_mode($fh);
}
View
36 lib/Dancer/Handler.pm
@@ -2,7 +2,7 @@ package Dancer::Handler;
use strict;
use warnings;
-use Carp 'croak';
+use Carp;
use File::stat;
use HTTP::Headers;
@@ -14,9 +14,14 @@ use Dancer::Renderer;
use Dancer::Config 'setting';
use Dancer::ModuleLoader;
use Dancer::Exception qw(:all);
+use Dancer::Factory::Hook;
use Encode;
+Dancer::Factory::Hook->instance->install_hooks(
+ qw/on_handler_exception/
+);
+
# This is where we choose which application handler to return
sub get_handler {
my $handler = 'Dancer::Handler::Standalone';
@@ -35,7 +40,7 @@ sub get_handler {
# load the app handler
my ($loaded, $error) = Dancer::ModuleLoader->load($handler);
- croak "Unable to load app handler `$handler': $error" if $error;
+ raise core_handler => "Unable to load app handler `$handler': $error" if $error;
# OK, everything's fine, load the handler
Dancer::Logger::core('loading ' . $handler . ' handler');
@@ -76,29 +81,32 @@ sub handle_request {
sub render_request {
my $request = shift;
my $action;
- $action = eval {
+ $action = try {
Dancer::Renderer->render_file
|| Dancer::Renderer->render_action
|| Dancer::Renderer->render_error(404);
- };
-
- my $value = is_dancer_exception(my $exception = $@);
- if ($value && $value & E_HALTED) {
- # special case for halted workflow exception: still render the response
+ } continuation {
+ # workflow exception (continuation)
+ my ($continuation) = @_;
+ $continuation->isa('Dancer::Continuation::Halted')
+ or $continuation->rethrow();
+ # special case for halted workflow continuation: still render the response
Dancer::Serializer->process_response(Dancer::SharedData->response);
- } elsif ($exception) {
+ } catch {
+ my ($exception) = @_;
+ Dancer::Factory::Hook->execute_hooks('on_handler_exception', $exception);
Dancer::Logger::error(
'request to ' . $request->path_info . " crashed: $exception");
+ # use stringification, to get exception message in case of a
+ # Dancer::Exception
Dancer::Error->new(
code => 500,
title => "Runtime Error",
- message => $exception,
- $value ? ( exception => $value,
- exceptions => { },
- ) : (),
+ message => "$exception",
+ exception => $exception,
)->render();
- }
+ };
return $action;
}
View
9 lib/Dancer/Handler/PSGI.pm
@@ -11,11 +11,12 @@ use Dancer::Config;
use Dancer::ModuleLoader;
use Dancer::SharedData;
use Dancer::Logger;
+use Dancer::Exception qw(:all);
sub new {
my $class = shift;
- croak "Plack::Request is needed by the PSGI handler"
+ raise core_handler_PSGI => "Plack::Request is needed by the PSGI handler"
unless Dancer::ModuleLoader->load('Plack::Request');
my $self = {};
@@ -42,7 +43,7 @@ sub apply_plack_middlewares_map {
my $mw_map = Dancer::Config::setting('plack_middlewares_map');
foreach my $req (qw(Plack::App::URLMap Plack::Builder)) {
- croak "$req is needed to use apply_plack_middlewares_map"
+ raise core_handler_PSGI => "$req is needed to use apply_plack_middlewares_map"
unless Dancer::ModuleLoader->load($req);
}
@@ -63,11 +64,11 @@ sub apply_plack_middlewares {
my $middlewares = Dancer::Config::setting('plack_middlewares');
- croak "Plack::Builder is needed for middlewares support"
+ raise core_handler_PSGI => "Plack::Builder is needed for middlewares support"
unless Dancer::ModuleLoader->load('Plack::Builder');
ref $middlewares eq "ARRAY"
- or croak "'plack_middlewares' setting must be an ArrayRef";
+ or raise core_handler_PSGI => "'plack_middlewares' setting must be an ArrayRef";
my $builder = Plack::Builder->new();
View
7 lib/Dancer/Handler/Standalone.pm
@@ -60,4 +60,11 @@ sub print_startup_info {
}
+# Restore expected behavior for wait(), as
+# HTTP::Server::Simple sets SIGCHLD to IGNORE.
+# (Issue #499)
+sub after_setup_listener {
+ $SIG{CHLD} = '';
+}
+
1;
View
24 lib/Dancer/Hook.pm
@@ -18,7 +18,7 @@ sub new {
my $self = bless {}, $class;
if (!scalar @args) {
- croak "one name and a coderef are required";
+ raise core_hook => "one name and a coderef are required";
}
my $hook_name = shift @args;
@@ -42,33 +42,35 @@ sub new {
$code = shift @args;
}
else {
- croak "something's wrong with parameters passed to Hook constructor";
+ raise core_hook => "something's wrong with parameters passed to Hook constructor";
}
ref $code eq 'CODE'
- or croak "the code argument passed to hook construction was not a CodeRef. Value was : '$code'";
+ or raise core_hook => "the code argument passed to hook construction was not a CodeRef. Value was : '$code'";
my $compiled_filter = sub {
+ my @arguments = @_;
return if Dancer::SharedData->response->halted;
my $app = Dancer::App->current();
return unless $properties->should_run_this_app($app->name);
Dancer::Logger::core( "entering " . $hook_name . " hook" );
- eval { $code->(@_) };
- if ( is_dancer_exception(my $exception = $@) ) {
- # propagate the exception
- die $exception;
- } elsif ($exception) {
- # exception is not a workflow halt but a genuine error
+
+
+ try { $code->(@arguments) }
+ catch {
+ my ($exception) = @_;
+ # exception is not a workflow continuation but a genuine error
my $err = Dancer::Error->new(
code => 500,
title => $hook_name . ' filter error',
- message => "An error occured while executing the filter named $hook_name: $exception"
+ message => "An error occured while executing the filter named $hook_name: $exception",
+ exception => $exception,
);
# raise a new halt exception
Dancer::halt( $err->render );
- }
+ };
};
$self->properties($properties);
View
8 lib/Dancer/Logger/Abstract.pm
@@ -60,10 +60,8 @@ sub format_message {
my ($self, $level, $message) = @_;
chomp $message;
- if (setting('charset')) {
- unless (uc setting('charset') eq "UTF-8" && Encode::is_utf8($message)) {
- $message = Encode::encode(setting('charset'), $message);
- }
+ if (my $charset = setting('charset')) {
+ $message = Encode::encode($charset, $message);
}
$level = 'warn' if $level eq 'warning';
@@ -92,7 +90,7 @@ sub format_message {
? $r->env->{'HTTP_X_REAL_IP'} || $r->env->{'REMOTE_ADDR'}
: '-';
},
- t => sub { Encode::decode(setting('charset'),
+ t => sub { Encode::decode(setting('charset') || 'utf8',
POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime )) },
T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime ) },
P => sub { $$ },
View
3 lib/Dancer/Object.pm
@@ -6,6 +6,7 @@ package Dancer::Object;
use strict;
use warnings;
use Carp;
+use Dancer::Exception qw(:all);
# constructor
sub new {
@@ -18,7 +19,7 @@ sub new {
sub clone {
my ($self) = @_;
- croak "The 'Clone' module is needed"
+ raise core => "The 'Clone' module is needed"
unless Dancer::ModuleLoader->load('Clone');
return Clone::clone($self);
}
View
5 lib/Dancer/Object/Singleton.pm
@@ -6,6 +6,7 @@ package Dancer::Object::Singleton;
use strict;
use warnings;
use Carp;
+use Dancer::Exception qw(:all);
use base qw(Dancer::Object);
@@ -15,12 +16,12 @@ my %instances;
# constructor
sub new {
my ($class) = @_;
- croak "you can't call 'new' on $class, as it's a singleton. Try to call 'instance'";
+ raise core => "you can't call 'new' on $class, as it's a singleton. Try to call 'instance'";
}
sub clone {
my ($class) = @_;
- croak "you can't call 'clone' on $class, as it's a singleton. Try to call 'instance'";
+ raise core => "you can't call 'clone' on $class, as it's a singleton. Try to call 'instance'";
}
sub instance {
View
8 lib/Dancer/Plugin.pm
@@ -6,6 +6,8 @@ use Carp;
use base 'Exporter';
use Dancer::Config 'setting';
use Dancer::Hook;
+use Dancer::Exception qw(:all);
+
use base 'Exporter';
use vars qw(@EXPORT);
@@ -34,19 +36,19 @@ sub register($&) {
my $plugin_name = caller();
$keyword =~ /^[a-zA-Z_]+[a-zA-Z0-9_]*$/
- or croak "You can't use '$keyword', it is an invalid name"
+ or raise core_plugin => "You can't use '$keyword', it is an invalid name"
. " (it should match ^[a-zA-Z_]+[a-zA-Z0-9_]*$ )";
if (
grep { $_ eq $keyword }
map { s/^(?:\$|%|&|@|\*)//; $_ }
(@Dancer::EXPORT, @Dancer::EXPORT_OK)
) {
- croak "You can't use '$keyword', this is a reserved keyword";
+ raise core_plugin => "You can't use '$keyword', this is a reserved keyword";
}
while (my ($plugin, $keywords) = each %$_keywords) {
if (grep { $_->[0] eq $keyword } @$keywords) {
- croak "You can't use $keyword, "
+ raise core_plugin => "You can't use $keyword, "
. "this is a keyword reserved by $plugin";
}
}
View
4 lib/Dancer/Renderer.pm
@@ -17,6 +17,7 @@ use Dancer::FileUtils qw(path path_or_empty dirname read_file_content open_file)
use Dancer::SharedData;
use Dancer::Logger;
use Dancer::MIME;
+use Dancer::Exception qw(:all);
Dancer::Factory::Hook->instance->install_hooks(
qw/before after before_serializer after_serializer before_file_render after_file_render/
@@ -103,7 +104,7 @@ sub get_action_response {
|| ($method ne Dancer::SharedData->request->method))
{
if ($depth > $MAX_RECURSIVE_LOOP) {
- croak "infinite loop detected, "
+ raise core_renderer => "infinite loop detected, "
. "check your route/filters for "
. $method . ' '
. $path;
@@ -182,6 +183,7 @@ sub get_file_response_for_path {
my $response = Dancer::SharedData->response() || Dancer::Response->new();
$response->status($status) if ($status);
$response->header('Content-Type' => (($mime && _get_full_mime_type($mime)) ||
+ Dancer::SharedData->request->content_type ||
_get_mime_type($static_file)));
$response->content($fh);
View
9 lib/Dancer/Request.pm
@@ -9,6 +9,7 @@ use base 'Dancer::Object';
use Dancer::Config 'setting';
use Dancer::Request::Upload;
use Dancer::SharedData;
+use Dancer::Exception qw(:all);
use Encode;
use HTTP::Body;
use URI;
@@ -56,7 +57,7 @@ sub host {
$_[0]->{host} = $_[1];
} else {
my $host;
- $host = $_[0]->env->{X_FORWARDED_HOST} if setting('behind_proxy');
+ $host = ($_[0]->env->{X_FORWARDED_HOST} || $_[0]->env->{HTTP_X_FORWARDED_HOST}) if setting('behind_proxy');
$host || $_[0]->{host} || $_[0]->env->{HTTP_HOST};
}
}
@@ -275,7 +276,7 @@ sub params {
return $self->{_route_params};
}
else {
- croak "Unknown source params \"$source\".";
+ raise core_request => "Unknown source params \"$source\".";
}
}
@@ -403,7 +404,7 @@ sub _build_path {
$path ||= $self->_url_decode($self->request_uri);
}
- croak "Cannot resolve path" if not $path;
+ raise core_request => "Cannot resolve path" if not $path;
$self->{path} = $path;
}
@@ -515,7 +516,7 @@ sub _read {
return $buffer;
}
else {
- croak "Unknown error reading input: $!";
+ raise core_request => "Unknown error reading input: $!";
}
}
View
3 lib/Dancer/Request/Upload.pm
@@ -7,6 +7,7 @@ use strict;
use warnings;
use base 'Dancer::Object';
use Dancer::FileUtils qw(open_file);
+use Dancer::Exception qw(:all);
Dancer::Request::Upload->attributes(
qw(
@@ -18,7 +19,7 @@ sub file_handle {
my ($self) = @_;
return $self->{_fh} if defined $self->{_fh};
my $fh = open_file('<', $self->tempname)
- or croak "Can't open `" . $self->tempname . "' for reading: $!";
+ or raise core_request => "Can't open `" . $self->tempname . "' for reading: $!";
$self->{_fh} = $fh;
}
View
2 lib/Dancer/Response.pm
@@ -12,6 +12,7 @@ use Dancer::MIME;
use HTTP::Headers;
use Dancer::SharedData;
use Dancer::Exception qw(:all);
+use Dancer::Continuation::Halted;
__PACKAGE__->attributes(qw/content pass streamed/);
@@ -101,7 +102,6 @@ sub halt {
halted => 1,
);
}
- raise E_HALTED;
}
sub halted {
View
27 lib/Dancer/Route.pm
@@ -10,6 +10,8 @@ use Dancer::Logger;
use Dancer::Config 'setting';
use Dancer::Request;
use Dancer::Response;
+use Dancer::Exception qw(:all);
+use Dancer::Factory::Hook;
Dancer::Route->attributes(
qw(
@@ -26,6 +28,10 @@ Dancer::Route->attributes(
)
);
+Dancer::Factory::Hook->instance->install_hooks(
+ qw/on_route_exception/
+);
+
# supported options and aliases
my @_supported_options = Dancer::Request->get_attributes();
my %_options_aliases = (agent => 'user_agent');
@@ -35,7 +41,7 @@ sub init {
$self->{'_compiled_regexp'} = undef;
if (!$self->pattern) {
- croak "cannot create Dancer::Route without a pattern";
+ raise core_route => "cannot create Dancer::Route without a pattern";
}
# If the route is a Regexp, store it directly
@@ -145,7 +151,7 @@ sub check_options {
return 1 unless defined $self->options;
for my $opt (keys %{$self->options}) {
- croak "Not a valid option for route matching: `$opt'"
+ raise core_route => "Not a valid option for route matching: `$opt'"
if not( (grep {/^$opt$/} @{$_supported_options[0]})
|| (grep {/^$opt$/} keys(%_options_aliases)));
}
@@ -166,7 +172,22 @@ sub validate_options {
sub run {
my ($self, $request) = @_;
- my $content = $self->execute();
+ my $content = try {
+ $self->execute();
+ } continuation {
+ my ($continuation) = @_;
+ # route related continuation
+ $continuation->isa('Dancer::Continuation::Route')
+ or $continuation->rethrow();
+ # If the continuation carries some content, get it
+ my $content = $continuation->return_value();
+ defined $content or return; # to avoid returning undef;
+ return $content;
+ } catch {
+ my ($exception) = @_;
+ Dancer::Factory::Hook->execute_hooks('on_route_exception', $exception);
+ die $exception;
+ };
my $response = Dancer::SharedData->response;
if ( $response && $response->is_forwarded ) {
View
5 lib/Dancer/Route/Cache.pm
@@ -10,6 +10,7 @@ use vars '$VERSION';
use Dancer::Config 'setting';
use Dancer::Error;
+use Dancer::Exception qw(:all);
$VERSION = '0.01';
Dancer::Route::Cache->attributes('size_limit', 'path_limit');
@@ -74,7 +75,7 @@ sub route_from_path {
my ($self, $method, $path) = @_;
$method && $path
- or croak "Missing method or path";
+ or raise core_route => "Missing method or path";
return $self->{'cache'}{$method}{$path} || undef;
}
@@ -83,7 +84,7 @@ sub store_path {
my ($self, $method, $path, $route) = @_;
$method && $path && $route
- or croak "Missing method, path or route";
+ or raise core_route => "Missing method, path or route";
$self->{'cache'}{$method}{$path} = $route;
View
3 lib/Dancer/Route/Registry.pm
@@ -5,6 +5,7 @@ use Carp;
use Dancer::Route;
use base 'Dancer::Object';
use Dancer::Logger;
+use Dancer::Exception qw(:all);
Dancer::Route::Registry->attributes(qw( id ));
@@ -98,7 +99,7 @@ sub any_add {
$pattern = shift @rest;
}
- croak "Syntax error, methods should be provided as an ARRAY ref"
+ raise core_route => "Syntax error, methods should be provided as an ARRAY ref"
if grep {$_ eq $pattern} @methods;
$self->universal_add($_, $pattern, @rest) for @methods;
View
3 lib/Dancer/Serializer.pm
@@ -77,7 +77,8 @@ sub process_request {
return $request
unless engine->support_content_type($request->content_type);
- return $request unless $request->is_put || $request->is_post;
+ return $request
+ unless $request->is_put || $request->is_post || $request->is_patch;
my $old_params = $request->params('body');
View
3 lib/Dancer/Serializer/Dumper.pm
@@ -5,6 +5,7 @@ use warnings;
use Carp;
use base 'Dancer::Serializer::Abstract';
use Data::Dumper;
+use Dancer::Exception qw(:all);
sub from_dumper {
my ($string) = @_;
@@ -29,7 +30,7 @@ sub serialize {
sub deserialize {
my ($self, $content) = @_;
my $res = eval "my \$VAR1; $content";
- croak "unable to deserialize : $@" if $@;
+ raise core_serializer => "unable to deserialize : $@" if $@;
return $res;
}
View
3 lib/Dancer/Serializer/JSON.pm