Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'release/1.3049_01'

  • Loading branch information...
commit bce041ac966d9f91d6775610eedd01239b67ec04 2 parents 3862c28 + e520494
Alexis Sukrieh authored
Showing with 1,150 additions and 311 deletions.
  1. +1 −0  AUTHORS
  2. +43 −1 CHANGES
  3. +15 −3 MANIFEST
  4. +1 −2  examples/dancr/dancr.pl
  5. +182 −20 lib/Dancer.pm
  6. +4 −0 lib/Dancer/App.pm
  7. +10 −1 lib/Dancer/Config.pm
  8. +3 −3 lib/Dancer/Cookbook.pod
  9. +3 −3 lib/Dancer/Development.pod
  10. +3 −3 lib/Dancer/Development/Integration.pod
  11. +8 −1 lib/Dancer/Error.pm
  12. +74 −0 lib/Dancer/Factory/Hook.pm
  13. +2 −1  lib/Dancer/HTTP.pm
  14. +10 −3 lib/Dancer/Handler.pm
  15. +7 −14 lib/Dancer/Handler/PSGI.pm
  16. +135 −0 lib/Dancer/Hook.pm
  17. +59 −0 lib/Dancer/Hook/Properties.pm
  18. +1 −1  lib/Dancer/Logger/Abstract.pm
  19. +2 −2 lib/Dancer/Plugin.pm
  20. +26 −12 lib/Dancer/Renderer.pm
  21. +54 −18 lib/Dancer/Request.pm
  22. +13 −6 lib/Dancer/Response.pm
  23. +1 −0  lib/Dancer/Route.pm
  24. +1 −33 lib/Dancer/Route/Registry.pm
  25. +7 −0 lib/Dancer/Serializer.pm
  26. +2 −0  lib/Dancer/Session.pm
  27. +14 −2 lib/Dancer/Template/Abstract.pm
  28. +9 −15 lib/Dancer/Test.pm
  29. +5 −4 lib/Dancer/Tutorial.pod
  30. +20 −10 script/dancer
  31. +1 −0  t/00_base/003_syntax.t
  32. +12 −1 t/00_base/004_args.t
  33. +3 −3 t/01_config/03_logger.t
  34. +0 −73 t/03_route_handler/02_before_filter.t
  35. +6 −4 t/03_route_handler/06_regexp.t
  36. +11 −0 t/03_route_handler/11_redirect.t
  37. +16 −7 t/03_route_handler/29_forward.t
  38. +2 −2 t/05_views/03_layout.t
  39. +0 −44 t/10_template/06_before_template_hook.t
  40. +30 −0 t/11_logger/11_runtime_file.t
  41. +2 −5 t/14_serializer/17_clear_serializer.t
  42. +1 −0  t/15_plugins/02_config.t
  43. +18 −0 t/22_hooks/00_syntax.t
  44. +23 −0 t/22_hooks/01_api.t
  45. +71 −0 t/22_hooks/02_before.t
  46. +11 −12 t/{03_route_handler/26_after_hook.t → 22_hooks/03_after.t}
  47. +38 −0 t/22_hooks/04_template.t
  48. +35 −0 t/22_hooks/05_layout.t
  49. +75 −0 t/22_hooks/06_serializer.t
  50. +42 −0 t/22_hooks/07_file.t
  51. +33 −0 t/22_hooks/08_error.t
  52. +1 −0  t/22_hooks/views/index.tt
  53. +2 −0  t/22_hooks/views/layouts/main.tt
  54. +2 −2 t/lib/MyAppFoo.pm
1  AUTHORS
View
@@ -6,3 +6,4 @@
Franck Cuny <franck@lumberjaph.net>
Naveed Massjouni <naveedm9@gmail.com>
Damien 'dams' Krotkine <dams@cpan.org>
+ Alberto Simões <ambs+dancer@perl-hackers.net>
44 CHANGES
View
@@ -1,4 +1,42 @@
-{{$NEXT}}
+1.3049_01 14.05.2011
+
+ [ API CHANGES ]
+ * Deprecation of 'logger' (use set). (Alberto Simões)
+ * Deprecate 'layout' (use set). (Alberto Simões)
+ * Definitely remove plack_middlewares HashRef deprecation.
+ (Alberto Simões & Damien Krotkine)
+
+ [ BUG FIXES ]
+ * Unbreaking auto_page somewhat - the catch-all route added will
+ pass unless a suitable view exists. This means that routes like
+ /foo are not obscured, and made up URLs will result in a proper
+ 404, not 500. A little more work required here, though.
+ (David Precious)
+ * Anchor regular expression routes. Before regular expressions
+ were matching anywhere in the URL.
+ (Alberto Simões)
+
+ [ ENHANCEMENTS ]
+ * GH #519: remove redundant lines from CSS
+ (Alberto Simões)
+ * When scaffolding an app, show a warning if YAML not installed.
+ Prompted by Issue 496. (David Precious)
+ * Hooks! add new positions for hooks, and possibility to create
+ your own hooks inside your application and your plugin.
+ (Franck Cuny)
+ * Don't try to read/set session vars with empty/undef keys. It
+ doesn't make sense to do so, and can cause warnings elsewhere.
+ (David Precious)
+ * Check HTTP status code/alias passed to status() is valid;
+ previously, and invalid code would result in the response status
+ being unset
+ (David Precious, prompted on IRC by jonas)
+ * Lowercase status aliases and swap spaces for underscores before
+ trying to match
+ (David Precious, suggested on IRC by jonas)
+ * Added 'behind_proxy' setting, making Dancer honor
+ X_FORWARDED_PROTOCOL and X_FORWARDED_HOST
+ (Alberto Simões, requested by sukria and others)
1.3040 01.05.2011
** Codename: Yanick in Black // Yanick Champoux, Labor Day - May Day **
@@ -23,8 +61,12 @@
(Sawyer X)
* Rewrite scalar usage of qw() that is incompatible with 5.14.
(Alberto Simões)
+ * Don't parse ARGV when under PSGI (closes #473)
+ (Franck Cuny)
[ ENHANCEMENTS ]
+ * Forward can change method GH#493
+ (Alberto Simões)
* Introducing the "megasplat"!
(Yanick Champoux)
* More tests for versions, setings and variables.
18 MANIFEST
View
@@ -22,12 +22,15 @@ lib/Dancer/Development.pod
lib/Dancer/Development/Integration.pod
lib/Dancer/Engine.pm
lib/Dancer/Error.pm
+lib/Dancer/Factory/Hook.pm
lib/Dancer/FileUtils.pm
lib/Dancer/GetOpt.pm
lib/Dancer/Handler.pm
lib/Dancer/Handler/Debug.pm
lib/Dancer/Handler/PSGI.pm
lib/Dancer/Handler/Standalone.pm
+lib/Dancer/Hook.pm
+lib/Dancer/Hook/Properties.pm
lib/Dancer/HTTP.pm
lib/Dancer/Introduction.pod
lib/Dancer/Logger.pm
@@ -135,7 +138,6 @@ t/03_route_handler/000_create_fake_env.t
t/03_route_handler/00_http_methods.t
t/03_route_handler/00_route_object.t
t/03_route_handler/01_params.t
-t/03_route_handler/02_before_filter.t
t/03_route_handler/03_passing.t
t/03_route_handler/04_wildcards.t
t/03_route_handler/04_wildcards_megasplat.t
@@ -160,7 +162,6 @@ t/03_route_handler/22_filter_halt.t
t/03_route_handler/23_filter_error_catching.t
t/03_route_handler/24_multiple_params.t
t/03_route_handler/24_named_captures.t
-t/03_route_handler/26_after_hook.t
t/03_route_handler/27_issue_77_pass_breaks_routes.t
t/03_route_handler/28_plack_mount.t
t/03_route_handler/29_forward.t
@@ -232,7 +233,6 @@ t/10_template/01_factory.t
t/10_template/02_abstract_class.t
t/10_template/03_simple.t
t/10_template/05_template_toolkit.t
-t/10_template/06_before_template_hook.t
t/10_template/extension.t
t/10_template/index.txt
t/10_template/template.t
@@ -251,6 +251,7 @@ t/11_logger/07_diag.t
t/11_logger/08_serialize.t
t/11_logger/09_capture.t
t/11_logger/10_note.t
+t/11_logger/11_runtime_file.t
t/12_response/000_create_fake_env.t
t/12_response/01_CRLF_injection.t
t/12_response/02_headers.t
@@ -307,6 +308,17 @@ t/19_dancer/01_script.t
t/19_dancer/02_script_version_from.t
t/20_deprecation/01_api.t
t/21_dependents/Dancer-Session-Cookie.t
+t/22_hooks/00_syntax.t
+t/22_hooks/01_api.t
+t/22_hooks/02_before.t
+t/22_hooks/03_after.t
+t/22_hooks/04_template.t
+t/22_hooks/05_layout.t
+t/22_hooks/06_serializer.t
+t/22_hooks/07_file.t
+t/22_hooks/08_error.t
+t/22_hooks/views/index.tt
+t/22_hooks/views/layouts/main.tt
t/lib/EasyMocker.pm
t/lib/Forum.pm
t/lib/LinkBlocker.pm
3  examples/dancr/dancr.pl
View
@@ -14,8 +14,7 @@
set 'warnings' => 1;
set 'username' => 'admin';
set 'password' => 'password';
-
-layout 'main';
+set 'layout' => 'main';
my $flash;
202 lib/Dancer.pm
View
@@ -5,7 +5,7 @@ use warnings;
use Carp;
use Cwd 'realpath';
-our $VERSION = '1.3040';
+our $VERSION = '1.3049_01';
our $AUTHORITY = 'SUKRIA';
use Dancer::App;
@@ -14,6 +14,7 @@ use Dancer::Cookies;
use Dancer::FileUtils;
use Dancer::GetOpt;
use Dancer::Error;
+use Dancer::Hook;
use Dancer::Logger;
use Dancer::Renderer;
use Dancer::Route;
@@ -54,6 +55,7 @@ our @EXPORT = qw(
halt
header
headers
+ hook
layout
load
load_app
@@ -96,10 +98,10 @@ our @EXPORT = qw(
# Dancer's syntax
-sub after { Dancer::Route::Registry->hook('after', @_) }
+sub after { Dancer::Hook->new('after', @_) }
sub any { Dancer::App->current->registry->any_add(@_) }
-sub before { Dancer::Route::Registry->hook('before', @_) }
-sub before_template { Dancer::Route::Registry->hook('before_template', @_) }
+sub before { Dancer::Hook->new('before', @_) }
+sub before_template { Dancer::Hook->new('before_template', @_) }
sub captures { Dancer::SharedData->request->params->{captures} }
sub cookies { Dancer::Cookies->cookies }
sub config { Dancer::Config::settings() }
@@ -121,10 +123,18 @@ sub halt { Dancer::SharedData->response->halt(@_) }
sub header { goto &headers }
sub push_header { Dancer::SharedData->response->push_header(@_); }
sub headers { Dancer::SharedData->response->headers(@_); }
-sub layout { set(layout => shift) }
+sub hook { Dancer::Hook->new(@_) }
+sub layout {
+ Dancer::Deprecation->deprecated(reason => "use 'set layout => \"value\"'",
+ version => '1.3050',
+ fatal => 0);
+ set(layout => shift) }
sub load { require $_ for @_ }
sub load_app { goto &_load_app } # goto doesn't add a call frame. So caller() will work as expected
-sub logger { set(logger => @_) }
+sub logger {
+ Dancer::Deprecation->deprecated(reason => "use 'set logger'",fatal => 0,version=>'1.3050');
+ set(logger => @_)
+}
sub mime { Dancer::MIME->instance() }
sub mime_type {
Dancer::Deprecation->deprecated(reason => "use 'mime' from Dancer.pm",fatal => 1)
@@ -194,6 +204,8 @@ sub import {
# if :syntax option exists, don't change settings
return if $syntax_only;
+ $as_script = 1 if $ENV{PLACK_ENV};
+
Dancer::GetOpt->process_args() if !$as_script;
_init_script_dir($script);
@@ -415,7 +427,7 @@ L<Exporter> means. For example:
use Test::More;
use Dancer qw(!pass);
-There are also some special tags to control exports and behavior.
+There are also some special tags to control exports and behaviour.
=head2 :moose
@@ -661,13 +673,21 @@ to the actual parameters:
return forward '/home', { authorized => 1 };
+Finally, you can add some more options to the forward method, in a
+third argument, also as a hash reference. At the moment that option is
+only used to change the method of your request. Use with caution.
+
+ return forward '/home', { auth => 1 }, { method => 'POST' };
+
=head2 from_dumper ($structure)
Deserializes a Data::Dumper structure.
=head2 from_json ($structure, %options)
-Deserializes a JSON structure. Can receive optional arguments. Thoses arguments are valid L<JSON> arguments to change the behavior of the default C<JSON::from_json> function.
+Deserializes a JSON structure. Can receive optional arguments. Those arguments
+are valid L<JSON> arguments to change the behaviour of the default
+C<JSON::from_json> function.
=head2 from_yaml ($structure)
@@ -675,7 +695,9 @@ Deserializes a YAML structure.
=head2 from_xml ($structure, %options)
-Deserializes a XML structure. Can receive optional arguments. Thoses arguments are valid L<XML::Simple> arguments to change the behavior of the default C<XML::Simple::XMLin> function.
+Deserializes a XML structure. Can receive optional arguments. Thoses arguments
+are valid L<XML::Simple> arguments to change the behaviour of the default
+C<XML::Simple::XMLin> function.
=head2 get
@@ -728,19 +750,159 @@ Do the same as C<header>, but allow for multiple headers with the same name.
will result in two headers "x-my-header" in the response
}
+=head2 hook
+
+Adds a hook at some position.
+
+ hook before_serialization => sub {
+ my $response = shift;
+ $response->content->{generated_at} = localtime();
+ };
+
+Supported B<before> hooks (in order of execution):
+
+=over 4
+
+=item before_deserializer
+
+This hook receives no arguments.
+
+ hook before_deserializer {
+ ...
+ };
+
+=item before_file_render
+
+This hook receives as argument the path of the file to render.
+
+ hook before_file_render {
+ ...
+ };
+
+=item before
+
+This is an alias to C<before>.
+
+This hook receives no arguments.
+
+ before sub {
+ ...
+ };
+
+It's equivalent to
+
+ hook before sub {
+ ...
+ };
+
+=item before_template_render
+
+This hook receives as argument a HASHREF, containing the tokens.
+
+This is an alias to 'before_template'
+
+ hook before_template_render sub {
+ my $tokens = shift;
+ delete $tokens->{user};
+ };
+
+=item before_layout_render
+
+This hook receives two arguments. The first one is a HASHREF containing the tokens. The second is a SCALARREF representing the content of the template.
+
+ hook before_layout_render sub {
+ my ($tokens, $html_ref) = @_;
+ ...
+ };
+
+=item before_serialization
+
+This hook receives as argument a L<Dancer::Response> object.
+
+ hook before_serializer sub {
+ my $response = shift;
+ $response->content->{start_time} = time();
+ };
+
+=back
+
+Supported B<after> hooks (in order of execution):
+
+=over 4
+
+=item after_deserializer
+
+This hook receives no arguments.
+
+ hook after_deserializer sub {
+ ...
+ };
+
+=item after_file_render
+
+This hook receives as argument a L<Dancer::Response> object.
+
+ hook after_file_render sub {
+ my $response = shift;
+ };
+
+=item after_template_render
+
+This hook receives as argument a SCALARREF representing the content generated by the template.
+
+ hook after_template_render sub {
+ my $html_ref = shift;
+ };
+
+=item after_layout_render
+
+This hook receives as argument a SCALARREF representing the content generated by the layout
+
+ hook after_layout_render sub {
+ my $html_ref = shift;
+ };
+
+=item after
+
+This hook receives as argument a L<Dancer::Response> object.
+
+ hook after sub {
+ my $response = shift;
+ };
+
+This is equivalent to
+
+ after sub {
+ my $response = shift;
+ };
+
+=item before_error_render
+
+This hook receives as argument a L<Dancer::Error> object.
+
+ hook before_error_render => sub {
+ my $error = shift;
+ };
+
+=item after_error_render
+
+This hook receives as argument a L<Dancer::Response> object.
+
+ hook after_error_render => sub {
+ my $response = shift;
+ };
+
+=back
+
=head2 layout
-Allows you to set the default layout to use when rendering a view. Syntactic
-sugar around the C<layout> setting:
+This method is deprecated. Use C<set>:
- layout 'user';
+ set layout => 'user';
=head2 logger
-Allows you to set the logger engine to use. Syntactic sugar around the
-C<logger> setting:
-
- logger 'console';
+Deprecated. Use C<set logger => 'console'> to change current logger engine.
=head2 load
@@ -751,7 +913,7 @@ sugar around Perl's C<require>:
=head2 load_app
-Loads a Dancer package. This method takes care to set the libdir to the curent
+Loads a Dancer package. This method takes care to set the libdir to the current
C<./lib> directory:
# if we have lib/Webapp.pm, we can load it like:
@@ -763,7 +925,7 @@ C<:syntax> option, in order not to change the application directory
=head2 mime_type
-Deprecated. Check C<mime> bellow.
+Deprecated. Check C<mime> below.
=head2 mime
@@ -1134,7 +1296,7 @@ Serializes a structure with Data::Dumper.
=head2 to_json ($structure, %options)
Serializes a structure to JSON. Can receive optional arguments. Thoses arguments
-are valid L<JSON> arguments to change the behavior of the default
+are valid L<JSON> arguments to change the behaviour of the default
C<JSON::to_json> function.
=head2 to_yaml ($structure)
@@ -1144,7 +1306,7 @@ Serializes a structure to YAML.
=head2 to_xml ($structure, %options)
Serializes a structure to XML. Can receive optional arguments. Thoses arguments
-are valid L<XML::Simple> arguments to change the behavior of the default
+are valid L<XML::Simple> arguments to change the behaviour of the default
C<XML::Simple::XMLout> function.
=head2 true
4 lib/Dancer/App.pm
View
@@ -76,6 +76,10 @@ sub find_route_through_apps {
my ($class, $request) = @_;
for my $app (Dancer::App->applications) {
my $route = $app->find_route($request);
+ if ($route) {
+ Dancer::App->current($route->app);
+ return $route;
+ }
return $route if $route;
}
return;
11 lib/Dancer/Config.pm
View
@@ -57,7 +57,11 @@ my $setters = {
'get', '/:page',
sub {
my $params = Dancer::SharedData->request->params;
- Dancer::template($params->{'page'});
+ if (-f Dancer::engine('template')->view($params->{page})) {
+ return Dancer::template($params->{'page'});
+ } else {
+ return Dancer::pass();
+ }
}
);
}
@@ -287,6 +291,11 @@ B<--port> switch.
If set to true, runs the standalone webserver in the background.
This setting can be changed on the command-line with the B<--daemon> flag.
+=head3 behind_proxy (boolean)
+
+If set to true, Dancer will look to C<X-Forwarded-Protocol> and
+C<X-Forwarded-host> when constructing URLs (for example, when using
+C<redirect>. This is useful if your application is behind a proxy.
=head2 Content type / character set
6 lib/Dancer/Cookbook.pod
View
@@ -421,8 +421,8 @@ keyword, and L<Crypt::SaltedHash> to handle salted hashed passwords (well, you
wouldn't store your users passwords in the clear, would you?)) follows:
post '/login' => sub {
- my $user = database()->selectrow_hashref(
- 'select * from users where username = ?', {}, params->{user}
+ my $user = database->quick_select('users',
+ { username => params->{user} }
);
if (!$user) {
warning "Failed login for unrecognised user " . params->{user};
@@ -527,7 +527,7 @@ Here is an example of a layout: C<views/layouts/main.tt> :
You can tell your app which layout to use with C<layout: name> in the config
file, or within your code:
- layout 'main';
+ set layout => 'main';
You can control which layout to use (or whether to use a layout at all) for a
specific request without altering the layout setting by passing an options
6 lib/Dancer/Development.pod
View
@@ -148,8 +148,8 @@ your clone (C<master> is used only for building releases).
$ git checkout -b devel upstream/devel
This will create a local branch in your clone named C<devel> and that
-will track the offical C<devel> branch. That way, if you have more or
-less commits than the upstream repo, you'll be immediatly notified by git.
+will track the official C<devel> branch. That way, if you have more or
+less commits than the upstream repo, you'll be immediately notified by git.
=item *
@@ -264,7 +264,7 @@ Official developers have write access to this repository, contributors are
invited to fork it if they want to submit patches, as explained in the
I<Patch submission> section.
-The repository layout is organized as follows:
+The repository layout is organised as follows:
=over 4
6 lib/Dancer/Development/Integration.pod
View
@@ -8,7 +8,7 @@ This documentation describes the procedure used for integrators to review and
merge contributions sent via pull-requests.
Every core-team member should read and apply the procedures described
-here. This will allow for a better history and more consitency in our
+here. This will allow for a better history and more consistency in our
ways of handling the (increasing number!) of pull requests.
=head1 TERMS
@@ -53,7 +53,7 @@ Let's say the user I<$user> has sent a PR, he has followed the
instructions described in L<Dancer::Development> so his work is based
on the integration branch (C<devel>).
-All the procedure described here is designed to avoid unecessary
+All the procedure described here is designed to avoid unnecessary
recursive-merge, in order to keep a clean and flat history in the
integration branch.
@@ -132,7 +132,7 @@ shiny commits we want.
Those release are built with git-flow (with C<git-flow release>) and are then
uploaded to CPAN.
-Since Dancer 1.2, we also have another parallell release cycle which is what we
+Since Dancer 1.2, we also have another parallel release cycle which is what we
call the I<frozen> branch. It's a maintenance-only release cycle. That branch is
created from the tag of the first release of a I<stable> version (namely a
release series with an even minor number).
9 lib/Dancer/Error.pm
View
@@ -10,10 +10,14 @@ use Dancer::Response;
use Dancer::Renderer;
use Dancer::Config 'setting';
use Dancer::Logger;
+use Dancer::Factory::Hook;
use Dancer::Session;
use Dancer::FileUtils qw(open_file);
use Dancer::Engine;
+Dancer::Factory::Hook->instance->install_hooks(
+ qw/before_error_render after_error_render/);
+
sub init {
my ($self) = @_;
@@ -166,7 +170,10 @@ sub render {
my $self = shift;
my $serializer = setting('serializer');
- $serializer ? $self->_render_serialized() : $self->_render_html();
+ Dancer::Factory::Hook->instance->execute_hooks('before_error_render', $self);
+ my $response = $serializer ? $self->_render_serialized() : $self->_render_html();
+ Dancer::Factory::Hook->instance->execute_hooks('after_error_render', $response);
+ $response;
}
sub _render_serialized {
74 lib/Dancer/Factory/Hook.pm
View
@@ -0,0 +1,74 @@
+package Dancer::Factory::Hook;
+
+use strict;
+use warnings;
+use Carp;
+
+use base 'Dancer::Object::Singleton';
+
+__PACKAGE__->attributes(qw/ hooks registered_hooks/);
+
+sub init {
+ my ( $class, $self ) = @_;
+ $self->hooks( {} );
+ $self->registered_hooks( [] );
+ return $self;
+}
+
+sub install_hooks {
+ my ( $self, @hooks_name ) = @_;
+
+ if ( !scalar @hooks_name ) {
+ croak "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";
+ }
+ $self->_add_hook( $hook_name );
+ }
+}
+
+sub register_hook {
+ my ( $self, $hook ) = @_;
+ $self->_add_registered_hook( $hook->name, $hook->code );
+}
+
+sub _add_registered_hook {
+ my ($class, $hook_name, $compiled_filter) = @_;
+ push @{$class->hooks->{$hook_name}}, $compiled_filter;
+}
+
+sub _add_hook {
+ my ($self, $hook_name ) = @_;
+ push @{$self->registered_hooks}, $hook_name;
+}
+
+sub hook_is_registered {
+ my ( $self, $hook_name ) = @_;
+ return grep { $_ eq $hook_name } @{$self->registered_hooks};
+}
+
+sub execute_hooks {
+ my ($self, $hook_name, @args) = @_;
+
+ croak("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");
+ }
+
+ $_->(@args) foreach @{$self->get_hooks_for($hook_name)};
+}
+
+sub get_hooks_for {
+ my ( $self, $hook_name ) = @_;
+
+ croak("Can't ask for hooks without a position") unless $hook_name;
+
+ $self->hooks->{$hook_name} || [];
+}
+
+
+1;
3  lib/Dancer/HTTP.pm
View
@@ -78,7 +78,8 @@ $HTTP_CODES->{error} = $HTTP_CODES->{internal_server_error};
sub status {
my ($class, $name) = @_;
return $name if $name =~ /^\d+$/;
- return $HTTP_CODES->{$name};
+ $name =~ s/\s/_/;
+ return $HTTP_CODES->{lc $name};
}
1;
13 lib/Dancer/Handler.pm
View
@@ -68,13 +68,20 @@ sub handle_request {
Dancer::App->reload_apps;
}
- eval {
+ render_request($request);
+ return $self->render_response();
+}
+
+sub render_request {
+ my $request = shift;
+ my $action;
+ $action = eval {
Dancer::Renderer->render_file
|| Dancer::Renderer->render_action
|| Dancer::Renderer->render_error(404);
};
if ($@) {
- Dancer::Logger::core(
+ Dancer::Logger::error(
'request to ' . $request->path_info . " crashed: $@");
Dancer::Error->new(
@@ -83,7 +90,7 @@ sub handle_request {
message => $@
)->render();
}
- return $self->render_response();
+ return $action;
}
sub psgi_app {
21 lib/Dancer/Handler/PSGI.pm
View
@@ -69,20 +69,13 @@ sub apply_plack_middlewares {
my $builder = Plack::Builder->new();
- # XXX remove this after 1.2
- if ( ref $middlewares eq 'HASH' ) {
- Dancer::Deprecation->deprecated(
- fatal => 1,
- feature => 'Listing Plack middlewares as a hash ref',
- reason => 'Must be listed as an array ref',
- );
- }
- else {
- map {
- Dancer::Logger::core "add middleware " . $_->[0];
- $builder->add_middleware(@$_)
- } @$middlewares;
- }
+ ref $middlewares eq "ARRAY"
+ or croak "'plack_middlewares' setting must be an ArrayRef";
+
+ map {
+ Dancer::Logger::core "add middleware " . $_->[0];
+ $builder->add_middleware(@$_)
+ } @$middlewares;
$app = $builder->to_app($app);
135 lib/Dancer/Hook.pm
View
@@ -0,0 +1,135 @@
+package Dancer::Hook;
+
+use strict;
+use warnings;
+use Carp;
+
+use base 'Dancer::Object';
+
+__PACKAGE__->attributes(qw/name code properties/);
+
+use Dancer::Factory::Hook;
+use Dancer::Hook::Properties;
+
+sub new {
+ my ($class, @args) = @_;
+
+ my $self = bless {}, $class;
+
+ if (!scalar @args) {
+ croak "one name and a coderef are required";
+ }
+
+ my $hook_name = shift @args;
+
+ # XXX at the moment, we have a filer position named "before_template".
+ # this one is renamed "before_template_render", so we need to alias it.
+ # maybe we need to deprecate 'before_template' to enforce the use
+ # of 'hook before_template_render => sub {}' ?
+ $hook_name = 'before_template_render' if $hook_name eq 'before_template';
+
+ $self->name($hook_name);
+
+ my ( $properties, $code );
+ if ( scalar @args == 1 ) {
+ $properties = Dancer::Hook::Properties->new();
+ $code = shift @args;
+ }
+ elsif ( scalar @args == 2 ) {
+ my $prop = shift @args;
+ $properties = Dancer::Hook::Properties->new(%$prop);
+ $code = shift @args;
+ }
+ else {
+ croak "something's wrong";
+ }
+
+ my $compiled_filter = sub {
+ 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 ($@) {
+ my $err = Dancer::Error->new(
+ code => 500,
+ title => $hook_name . ' filter error',
+ message => "An error occured while executing the filter named $hook_name: $@"
+ );
+ return Dancer::halt( $err->render );
+ }
+ };
+
+ $self->properties($properties);
+ $self->code($compiled_filter);
+
+ Dancer::Factory::Hook->instance->register_hook($self);
+ return $self;
+}
+
+1;
+
+=head1 NAME
+
+Dancer::Hook - Class to manipulate hooks with Dancer
+
+=head1 DESCRIPTION
+
+Manipulate hooks with Dancer
+
+=head1 SYNOPSIS
+
+ # inside a plugin
+ use Dancer::Hook;
+ Dancer::Hook->register_hooks_name(qw/before_auth after_auth/);
+
+=head1 METHODS
+
+=head2 register_hook ($hook_name, [$properties], $code)
+
+ hook 'before', {apps => ['main']}, sub {...};
+
+ hook 'before' => sub {...};
+
+Attaches a hook at some point, with a possible list of properties.
+
+Currently supported properties:
+
+=over 4
+
+=item apps
+
+ an array reference containing apps name
+
+=back
+
+=head2 register_hooks_name
+
+Add a new hook name, so developpers of application can insert some code at this point.
+
+ package My::Dancer::Plugin;
+ Dancer::Hook->instance->register_hooks_name(qw/before_auth after_auth/);
+
+=head2 hook_is_registered
+
+Test if a hook with this name has already been registered.
+
+=head2 execute_hooks
+
+Execute a list of hooks for some position
+
+=head2 get_hooks_for
+
+Returns the list of coderef registered for a given position
+
+=head1 AUTHORS
+
+This module has been written by Alexis Sukrieh and others.
+
+=head1 LICENSE
+
+This module is free software and is published under the same
+terms as Perl itself.
59 lib/Dancer/Hook/Properties.pm
View
@@ -0,0 +1,59 @@
+package Dancer::Hook::Properties;
+
+use strict;
+use warnings;
+
+use base 'Dancer::Object';
+
+Dancer::Hook::Properties->attributes(qw/apps/);
+
+sub init {
+ my ($self, %args) = @_;
+
+ $self->_init_apps(\%args);
+ return $self;
+}
+
+sub _init_apps {
+ my ( $self, $args ) = @_;
+ if ( my $apps = $args->{'apps'} ) {
+ ref $apps ? $self->apps($apps) : $self->apps( [$apps] );
+ return;
+ }
+ else {
+ $self->apps( [] );
+ }
+}
+
+sub should_run_this_app {
+ my ( $self, $app ) = @_;
+
+ return 1 unless scalar( @{ $self->apps } );
+
+ if ( $self->apps ) {
+ return grep { $_ eq $app } @{ $self->apps };
+ }
+}
+
+1;
+
+=head1 NAME
+
+Dancer::Hook::Properties - Properties attached to a hook
+
+=head1 DESCRIPTION
+
+Properties attached to a hook
+
+=head1 SYNOPSIS
+
+=head1 METHODS
+
+=head1 AUTHORS
+
+This module has been written by Alexis Sukrieh and others.
+
+=head1 LICENSE
+
+This module is free software and is published under the same
+terms as Perl itself.
2  lib/Dancer/Logger/Abstract.pm
View
@@ -10,7 +10,7 @@ use Dancer::Timer;
use Dancer::Config 'setting';
use POSIX qw/strftime/;
-# This is the only method to implement if logger engines.
+# This is the only method to implement by logger engines.
# It receives the following arguments:
# $msg_level, $msg_content, it gets called only if the configuration allows
# a message of the given level to be logged.
4 lib/Dancer/Plugin.pm
View
@@ -5,7 +5,7 @@ use Carp;
use base 'Exporter';
use Dancer::Config 'setting';
-
+use Dancer::Hook;
use base 'Exporter';
use vars qw(@EXPORT);
@@ -20,7 +20,7 @@ sub register($&);
my $_keywords = {};
-sub add_hook { Dancer::Route::Registry->hook(@_) }
+sub add_hook { Dancer::Hook->new(@_) }
sub plugin_setting {
my $plugin_orig_name = caller();
38 lib/Dancer/Renderer.pm
View
@@ -7,6 +7,7 @@ use HTTP::Headers;
use Dancer::Route;
use Dancer::HTTP;
use Dancer::Cookie;
+use Dancer::Factory::Hook;
use Dancer::Cookies;
use Dancer::Request;
use Dancer::Response;
@@ -17,6 +18,10 @@ use Dancer::SharedData;
use Dancer::Logger;
use Dancer::MIME;
+Dancer::Factory::Hook->instance->install_hooks(
+ qw/before after before_serializer after_serializer before_file_render after_file_render/
+);
+
sub render_file { get_file_response() }
sub render_action {
@@ -83,10 +88,10 @@ sub get_action_response {
my $handler =
Dancer::App->find_route_through_apps(Dancer::SharedData->request);
+ my $app = ($handler && $handler->app) ? $handler->app : Dancer::App->current();
+
# run the before filters, before "running" the route handler
- my $app = Dancer::App->current;
- $app = $handler->{app} if ($handler);
- $_->() for @{$app->registry->hooks->{before}};
+ Dancer::Factory::Hook->instance->execute_hooks('before');
# recurse if something has changed
my $MAX_RECURSIVE_LOOP = 10;
@@ -116,13 +121,11 @@ sub get_action_response {
# a response may exist, produced by a before filter
return serialize_response_if_needed() if defined $response && $response->exists;
# else, get the route handler's response
- Dancer::App->current($handler->app);
- my $response = $handler->run($request);
- return undef unless $response; # 404
-
+ Dancer::App->current($handler->{app});
+ $handler->run($request);
serialize_response_if_needed();
my $resp = Dancer::SharedData->response();
- $_->($resp) for (@{$app->registry->hooks->{after}});
+ Dancer::Factory::Hook->instance->execute_hooks('after', $resp);
return $resp;
}
else {
@@ -132,8 +135,12 @@ sub get_action_response {
sub serialize_response_if_needed {
my $response = Dancer::SharedData->response();
- $response = Dancer::Serializer->process_response($response)
- if Dancer::App->current->setting('serializer') && $response->content();
+
+ if (Dancer::App->current->setting('serializer') && $response->content()){
+ Dancer::Factory::Hook->execute_hooks('before_serializer', $response);
+ Dancer::Serializer->process_response($response);
+ Dancer::Factory::Hook->execute_hooks('after_serializer', $response);
+ }
return $response;
}
@@ -142,8 +149,9 @@ sub get_file_response {
my $path_info = $request->path_info;
my $app = Dancer::App->current;
my $static_file = path($app->setting('public'), $path_info);
- return Dancer::Renderer->get_file_response_for_path($static_file, undef,
- $request->content_type);
+
+ return Dancer::Renderer->get_file_response_for_path( $static_file, undef,
+ $request->content_type );
}
sub get_file_response_for_path {
@@ -151,6 +159,9 @@ sub get_file_response_for_path {
$status ||= 200;
if ( -f $static_file ) {
+ Dancer::Factory::Hook->execute_hooks( 'before_file_render',
+ $static_file );
+
my $fh = open_file( '<', $static_file );
binmode $fh;
my $response = Dancer::SharedData->response() || Dancer::Response->new();
@@ -158,6 +169,9 @@ sub get_file_response_for_path {
$response->header('Content-Type' => (($mime && _get_full_mime_type($mime)) ||
_get_mime_type($static_file)));
$response->content($fh);
+
+ Dancer::Factory::Hook->execute_hooks( 'after_file_render', $response );
+
return $response;
}
return;
72 lib/Dancer/Request.pm
View
@@ -6,6 +6,7 @@ use Carp;
use base 'Dancer::Object';
+use Dancer::Config 'setting';
use Dancer::Request::Upload;
use Dancer::SharedData;
use Encode;
@@ -14,9 +15,9 @@ use URI;
use URI::Escape;
my @http_env_keys = (
- 'user_agent', 'host', 'accept_language', 'accept_charset',
+ 'user_agent', 'accept_language', 'accept_charset',
'accept_encoding', 'keep_alive', 'connection', 'accept',
- 'accept_type', 'referer',
+ 'accept_type', 'referer', #'host', managed manually
);
my $count = 0;
@@ -36,13 +37,28 @@ sub agent { $_[0]->user_agent }
sub remote_address { $_[0]->address }
sub forwarded_for_address { $_[0]->env->{'X_FORWARDED_FOR'} }
sub address { $_[0]->env->{REMOTE_ADDR} }
+sub host {
+ if (@_==2) {
+ $_[0]->{host} = $_[1];
+ } else {
+ my $host;
+ $host = $_[0]->env->{X_FORWARDED_HOST} if setting('behind_proxy');
+ $host || $_[0]->{host} || $_[0]->env->{HTTP_HOST};
+ }
+}
sub remote_host { $_[0]->env->{REMOTE_HOST} }
sub protocol { $_[0]->env->{SERVER_PROTOCOL} }
sub port { $_[0]->env->{SERVER_PORT} }
sub request_uri { $_[0]->env->{REQUEST_URI} }
sub user { $_[0]->env->{REMOTE_USER} }
sub script_name { $_[0]->env->{SCRIPT_NAME} }
-sub scheme { $_[0]->env->{'psgi.url_scheme'} }
+sub scheme {
+ my $scheme;
+ if (setting('behind_proxy')) {
+ $scheme = $_[0]->env->{'X_FORWARDED_PROTOCOL'} || $_[0]->env->{'HTTP_FORWARDED_PROTO'}
+ }
+ return $scheme || $_[0]->env->{'psgi.url_scheme'} || $_[0]->env->{'PSGI.URL_SCHEME'};
+}
sub secure { $_[0]->scheme eq 'https' }
sub uri { $_[0]->request_uri }
@@ -97,10 +113,11 @@ sub new_for_request {
$params ||= {};
$method = uc($method);
- my $req =
- $class->new({%ENV, PATH_INFO => $path, REQUEST_METHOD => $method});
- $req->{params} = {%{$req->{params}}, %{$params}};
- $req->{body} = $body if defined $body;
+ my $req = $class->new( { %ENV,
+ PATH_INFO => $path,
+ REQUEST_METHOD => $method});
+ $req->{params} = {%{$req->{params}}, %{$params}};
+ $req->{body} = $body if defined $body;
$req->{headers} = $headers if $headers;
return $req;
@@ -118,6 +135,11 @@ sub forward {
my $new_params = _merge_params(scalar($request->params),
$to_data->{params} || {});
+ if (exists($to_data->{options}{method})) {
+ die unless _valid_method($to_data->{options}{method});
+ $new_request->{method} = uc $to_data->{options}{method};
+ }
+
$new_request->{params} = $new_params;
$new_request->{body} = $request->body;
$new_request->{headers} = $request->headers;
@@ -125,6 +147,11 @@ sub forward {
return $new_request;
}
+sub _valid_method {
+ my $method = shift;
+ return $method =~ /^(?:head|post|get|put|delete)$/i;
+}
+
sub _merge_params {
my ($params, $to_add) = @_;
@@ -145,13 +172,11 @@ sub base {
sub _common_uri {
my $self = shift;
- my @env_names = qw(
- SERVER_NAME HTTP_HOST SERVER_PORT SCRIPT_NAME psgi.url_scheme
- );
-
- my ($server, $host, $port, $path, $scheme) = @{$self->env}{@env_names};
-
- $scheme ||= $self->{'env'}{'PSGI.URL_SCHEME'}; # Windows
+ my $path = $self->env->{SCRIPT_NAME};
+ my $port = $self->env->{SERVER_PORT};
+ my $server = $self->env->{SERVER_NAME};
+ my $host = $self->host;
+ my $scheme = $self->scheme;
my $uri = URI->new;
$uri->scheme($scheme);
@@ -549,7 +574,7 @@ objects. It uses the environment hash table given to build the request object.
=head2 new_for_request($method, $path, $params, $body, $headers)
-An alternate constructor convinient for test scripts which creates a request
+An alternate constructor convienient for test scripts which creates a request
object with the arguments given.
=head2 forward($request, $new_location)
@@ -558,9 +583,16 @@ Create a new request which is a clone of the current one, apart
from the path location, which points instead to the new location.
This is used internally to chain requests using the forward keyword.
+Note that the new location should be a hash reference. Only one key is
+required, the C<to_url>, that should point to the URL that forward
+will use. Optional values are the key C<params> to a hash of
+parameters to be added to the current request parameters, and the key
+C<options> that points to a hash of options about the redirect (for
+instance, C<method> pointing to a new request method).
+
=head2 to_string()
-Return a string represeting the request object (eg: C<"GET /some/path">)
+Return a string representing the request object (eg: C<"GET /some/path">)
=head2 method()
@@ -609,7 +641,7 @@ Return the scheme of the request
=head2 secure()
-Return true of false, indicating wether the connection is secure
+Return true of false, indicating whether the connection is secure
=head2 is_get()
@@ -758,7 +790,7 @@ table provided by C<uploads()>. It looks at the calling context and returns a
corresponding value.
If you have many file uploads under the same name, and call C<upload('name')> in
-an array context, the accesor will unroll the ARRA ref for you:
+an array context, the accesor will unroll the ARRAY ref for you:
my @uploads = request->upload('many_uploads'); # OK
@@ -793,6 +825,10 @@ Dancer::Request object through specific accessors, here are those supported:
=item C<forwarded_for_address>
+=item C<forwarded_protocol>
+
+=item C<forwarded_host>
+
=item C<host>
=item C<keep_alive>
19 lib/Dancer/Response.pm
View
@@ -39,9 +39,15 @@ sub status {
my $self = shift;
if (scalar @_ > 0) {
- return $self->{status} = Dancer::HTTP->status(shift);
- }
- else {
+ my $status = shift;
+ my $numeric_status = Dancer::HTTP->status($status);
+ if ($numeric_status) {
+ return $self->{status} = $numeric_status;
+ } else {
+ carp "Unrecognised HTTP status $status";
+ return;
+ }
+ } else {
return $self->{status};
}
}
@@ -63,9 +69,10 @@ sub has_passed {
}
sub forward {
- my ($self, $uri, $params) = @_;
- $self->{forward} = { to_url => $uri,
- params => $params };
+ my ($self, $uri, $params, $opts) = @_;
+ $self->{forward} = { to_url => $uri,
+ params => $params,
+ options => $opts };
}
sub is_forwarded {
1  lib/Dancer/Route.pm
View
@@ -296,6 +296,7 @@ sub _build_regexp {
if ($self->is_regexp) {
$self->{_compiled_regexp} = $self->regexp || $self->pattern;
+ $self->{_compiled_regexp} = qr/^$self->{_compiled_regexp}$/;
$self->{_should_capture} = 1;
}
else {
34 lib/Dancer/Route/Registry.pm
View
@@ -6,12 +6,7 @@ use Dancer::Route;
use base 'Dancer::Object';
use Dancer::Logger;
-Dancer::Route::Registry->attributes(
- qw(
- id
- hooks
- )
-);
+Dancer::Route::Registry->attributes(qw( id ));
my $id = 1;
@@ -22,7 +17,6 @@ sub init {
$self->id($id++);
}
$self->{routes} = {};
- $self->{hooks} = {};
return $self;
}
@@ -35,34 +29,8 @@ sub is_empty {
return 1;
}
-sub hook {
- my ($class, $position, $filter) = @_;
- return Dancer::App->current->registry->add_hook($position, $filter);
-}
-
# replace any ':foo' by '(.+)' and stores all the named
# matches defined in $REG->{route_params}{$route}
-sub add_hook {
- my ($self, $position, $filter) = @_;
-
- my $compiled_filter = sub {
- return if Dancer::SharedData->response->halted;
- Dancer::Logger::core("entering " . $position . " hook");
- eval { $filter->(@_) };
- if ($@) {
- my $err = Dancer::Error->new(
- code => 500,
- title => $position . ' filter error',
- message =>
- "An error occured while executing the filter at position $position: $@"
- );
- return Dancer::halt($err->render);
- }
- };
- push @{$self->hooks->{$position}}, $compiled_filter;
- return $compiled_filter;
-}
-
sub routes {
my ($self, $method) = @_;
7 lib/Dancer/Serializer.pm
View
@@ -6,9 +6,12 @@ use strict;
use warnings;
use Dancer::ModuleLoader;
use Dancer::Engine;
+use Dancer::Factory::Hook;
use Dancer::Error;
use Dancer::SharedData;
+Dancer::Factory::Hook->instance->install_hooks(qw/before_deserializer after_deserializer/);
+
my $_engine;
sub engine {
@@ -68,6 +71,8 @@ sub process_response {
sub process_request {
my ($class, $request) = @_;
+ Dancer::Factory::Hook->execute_hooks('before_deserializer');
+
return $request unless engine;
return $request
unless engine->support_content_type($request->content_type);
@@ -90,6 +95,8 @@ sub process_request {
? $request->_set_body_params({%$old_params, %$new_params})
: $request->_set_body_params($new_params);
+ Dancer::Factory::Hook->execute_hooks('after_deserializer');
+
return $request;
}
2  lib/Dancer/Session.pm
View
@@ -37,12 +37,14 @@ sub get { get_current_session() }
sub read {
my ($class, $key) = @_;
+ return unless $key;
my $session = get_current_session();
return $session->{$key};
}
sub write {
my ($class, $key, $value) = @_;
+ return unless $key;
my $session = get_current_session();
$session->{$key} = $value;
16 lib/Dancer/Template/Abstract.pm
View
@@ -4,12 +4,17 @@ use strict;
use warnings;
use Carp;
+use Dancer::Factory::Hook;
use Dancer::Deprecation;
use Dancer::FileUtils 'path';
use base 'Dancer::Engine';
-# Overloads this method to implement the rendering
+Dancer::Factory::Hook->instance->install_hooks(
+ qw/before_template_render after_template_render before_layout_render after_layout_render/
+);
+
+# overloads this method to implement the rendering
# args: $self, $template, $tokens
# return: a string of $template's content processed with $tokens
sub render { confess "render not implemented" }
@@ -50,10 +55,12 @@ sub apply_renderer {
$view = $self->view($view);
- $_->($tokens) for (@{Dancer::App->current->registry->hooks->{before_template}});
+ Dancer::Factory::Hook->execute_hooks('before_template_render', $tokens);
my $content = $self->render($view, $tokens);
+ Dancer::Factory::Hook->execute_hooks('after_template_render', \$content);
+
# make sure to avoid ( undef ) in list context return
defined $content
and return $content;
@@ -78,8 +85,13 @@ sub apply_layout {
defined $layout or return $content;
+ Dancer::Factory::Hook->execute_hooks('before_layout_render', $tokens, \$content);
+
my $full_content =
$self->layout($layout, $tokens, $content);
+
+ Dancer::Factory::Hook->execute_hooks('after_layout_render', \$full_content);
+
# make sure to avoid ( undef ) in list context return
defined $full_content
and return $full_content;
24 lib/Dancer/Test.pm
View
@@ -15,6 +15,7 @@ use Dancer::Deprecation;
use Dancer::Request;
use Dancer::SharedData;
use Dancer::Renderer;
+use Dancer::Handler;
use Dancer::Config;
use Dancer::FileUtils qw(open_file);
@@ -235,7 +236,6 @@ sub response_headers_include {
my $tb = Test::Builder->new;
my $response = dancer_response(expand_req($req));
-
return $tb->ok(_include_in_headers($response->headers_to_array, $expected), $test_name);
}
@@ -309,7 +309,8 @@ Content-Type: text/plain
$content =~ s/\n/\r\n/g;
}
- my $l = length $content;
+ my $l = 0;
+ $l = length $content if defined $content;
open my $in, '<', \$content;
$ENV{'CONTENT_LENGTH'} = $l;
$ENV{'CONTENT_TYPE'} = $content_type;
@@ -337,20 +338,13 @@ Content-Type: text/plain
# then store the request
Dancer::SharedData->request($request);
- # duplicate some code from Dancer::Handler
- my $get_action = eval {
- Dancer::Renderer->render_file
- || Dancer::Renderer->render_action
- || Dancer::Renderer->render_error(404);
- };
- if ($@) {
- Dancer::Error->new(
- code => 500,
- title => "Runtime Error",
- message => $@
- )->render();
- }
+ # XXX this is a hack!!
+ $request = Dancer::Serializer->process_request($request)
+ if Dancer::App->current->setting('serializer');
+
+ my $get_action = Dancer::Handler::render_request($request);
my $response = Dancer::SharedData->response();
+
$response->content('') if $method eq 'HEAD';
Dancer::SharedData->reset_response();
return $response if $get_action;
9 lib/Dancer/Tutorial.pod
View
@@ -28,7 +28,9 @@ That's the reason I wrote this tutorial. While I was investigating some Python
or L<Bottle|http://bottle.paws.de/docs/dev/index.html> I enjoyed the way they explained step by step how to build an example application
which was a little more involved that a trivial example.
-Using the L<Flaskr|http://github.com/mitsuhiko/flask/tree/master/examples/flaskr/> sample application as my inspiration (OK, shamelessly plagerized) I
+Using the
+L<Flaskr|http://github.com/mitsuhiko/flask/tree/master/examples/flaskr/> sample
+application as my inspiration (OK, shamelessly plagiarised) I
translated that application to the Dancer framework so I could better understand how Dancer worked. (I'm learning
it too!)
@@ -366,7 +368,7 @@ I mentioned near the beginning of this tutorial that it is possible to create a
C<layout> template. In Dancr, that layout is called C<main> and it's set up by
putting in a directive like this:
- layout 'main';
+ set layout => 'main';
near the top of your web application. What this tells Dancer's template engine
is that it should look for a file called F<main.tt> in C<dancr/views/layouts/>
@@ -448,8 +450,7 @@ Here's the complete dancr.pl script from start to finish.
set 'warnings' => 1;
set 'username' => 'admin';
set 'password' => 'password';
-
- layout 'main';
+ set 'layout' => 'main';
my $flash;
30 script/dancer
View
@@ -53,6 +53,23 @@ version_check() if $do_check_dancer_version;
safe_mkdir($DANCER_APP_DIR);
create_node( app_tree($name), $DANCER_APP_DIR );
+unless (eval "require YAML") {
+ print <<NOYAML;
+*****
+WARNING: YAML.pm is not installed. This is not a full dependency, but is highly
+recommended; in particular, the scaffolded Dancer app being created will not be
+able to read settings from the config file without YAML.pm being installed.
+
+To resolve this, simply install YAML from CPAN, for instance using one of the
+following commands:
+
+ cpan YAML
+ perl -MCPAN -e 'install YAML'
+ curl -L http://cpanmin.us | perl - --sudo YAML
+*****
+NOYAML
+}
+
# subs
sub validate_app_name {
@@ -60,7 +77,7 @@ sub validate_app_name {
if ($name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
print STDERR "Error: Invalid application name.\n";
print STDERR "Application names must not contain colons,"
- ." dots or start with a number.\n";
+ ." dots, hyphens or start with a number.\n";
exit;
}
}
@@ -561,12 +578,11 @@ true;
'style.css' =>
'
body {
-font-family: \'Linux Libertine\', Palatino, \'Palatino Linotype\', \'Book Antiqua\', Georgia, \'Times New Roman\', serif;
margin: 0;
margin-bottom: 25px;
padding: 0;
background-color: #ddd;
-background-image: url("/images/perldancer-bg.jpg");
+background-image: url("/images/perldancer-bg.jpg");
background-repeat: no-repeat;
background-position: top left;
@@ -587,7 +603,6 @@ color: white;
text-decoration: none;
}
-
#page {
background-color: #ddd;
width: 750px;
@@ -617,7 +632,7 @@ padding-right: 30px;
#header {
-background-image: url("/images/perldancer.jpg");
+background-image: url("/images/perldancer.jpg");
background-repeat: no-repeat;
background-position: top left;
height: 64px;
@@ -629,7 +644,6 @@ font-weight: normal;
font-size: 16px;
}
-
#about h3 {
margin: 0;
margin-bottom: 10px;
@@ -664,7 +678,6 @@ margin: 0;
padding: 10px;
}
-
#getting-started {
border-top: 1px solid #ccc;
margin-top: 25px;
@@ -701,7 +714,6 @@ color: #555;
font-size: 13px;
}
-
#search {
margin: 0;
padding-top: 10px;
@@ -714,7 +726,6 @@ margin: 2px;
}
#search-text {width: 170px}
-
#sidebar ul {
margin-left: 0;
padding-left: 0;
@@ -732,7 +743,6 @@ list-style-type: none;
margin-bottom: 5px;
}
-
h1, h2, h3, h4, h5 {
font-family: sans-serif;
margin: 1.2em 0 0.6em 0;
1  t/00_base/003_syntax.t
View
@@ -23,6 +23,7 @@ my @keywords = qw(
halt
header
headers
+ hook
layout
load
load_app
13 t/00_base/004_args.t
View
@@ -27,7 +27,7 @@ my @tests = (
expected => sub { setting('auto_reload') == 0}},
);
-plan tests => scalar(@tests) + 1;
+plan tests => scalar(@tests) + 3;
foreach my $test (@tests) {
@ARGV = @{ $test->{args}};
@@ -37,3 +37,14 @@ foreach my $test (@tests) {
}
ok(Dancer::GetOpt->print_usage());
+
+# Dancer->import process ARGV
+@ARGV = ('--port=1234');
+Dancer->import();
+is setting('port'), 1234, "->import process ARGV";
+
+# Dancer->import doesn't process ARGV when PLACK_ENV is set (GH#473)
+@ARGV = ('--port=4321');
+$ENV{PLACK_ENV} = 'development';
+Dancer->import();
+is setting('port'), 1234, "->import doesn't process ARGV";
6 t/01_config/03_logger.t
View
@@ -9,10 +9,10 @@ use File::Spec qw/catfile/;
my $dir = tempdir(CLEANUP => 1, TMPDIR => 1);
set appdir => $dir;
-eval { logger 'foobar' };
+eval { set logger => 'foobar' };
like($@, qr/unknown logger/, 'invalid logger detected');
-ok(logger('file'), 'file-based logger correctly set');
+ok(set(logger => 'file'), 'file-based logger correctly set');
my $message = 'this is a test log message';
@@ -35,7 +35,7 @@ ok(grep(/warn \@.*$message/, @content), 'warning message found');
ok(grep(/error \@.*$message/, @content), 'error message found');
set environment => 'test';
-logger 'file';
+set logger => 'file';
my $test_logfile = Dancer::FileUtils::d_catfile($logdir, "test.log");
ok((-r $test_logfile), "environment logfile exists");
73 t/03_route_handler/02_before_filter.t
View
@@ -1,73 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 17, import => ['!pass'];
-use Dancer ':syntax';
-use Dancer::Test;
-
-my $i = 0;
-
-ok(
- before(
- sub {
- content_type('text/xhtml');
- }
- )
-);
-
-ok(
- before(
- sub {
- if ( request->path_info eq '/redirect_from' ) {
- redirect('/redirect_to');
- }
- else {
- params->{number} = 42;
- var notice => "I am here";
- request->path_info('/');
- }
- }
- ),
- 'before filter is defined'
-);
-
-ok(
- get(
- '/' => sub {
- is( params->{number}, 42, "params->{number} is set" );
- is( "I am here", vars->{notice}, "vars->{notice} is set" );
- return 'index';
- }
- ),
- 'index route is defined'
-);
-
-ok(
- get(
- '/redirect_from' => sub {
- $i++;
- }
- )
-);
-
-route_exists [GET => '/'];
-response_exists [GET => '/'];
-
-my $path = '/somewhere';
-my $request = [ GET => $path ];
-
-route_doesnt_exist $request,
- "there is no route handler for $path...";
-
-response_exists $request,
- "...but a response is returned though";
-
-response_content_is $request, 'index',
- "which is the result of a redirection to /";
-
-response_headers_include [GET => '/redirect_from'] => [
- 'Location' => 'http://localhost/redirect_to',
- 'Content-Type' => 'text/xhtml',
-];
-
-is $i, 0, 'never gone to redirect_from';
10 t/03_route_handler/06_regexp.t
View
@@ -1,6 +1,6 @@
use strict;
use warnings;
-use Test::More tests => 9, import => ['!pass'];
+use Test::More tests => 10, import => ['!pass'];
use Dancer ':syntax';
use Dancer::Test;
@@ -24,10 +24,12 @@ foreach my $test (@tests) {
my $handle;
my $path = $test->{path};
my $expected = $test->{expected};
-
+
my $request = [GET => $path];
-
+
response_exists($request, "route handler found for path `$path'");
- response_content_is_deeply($request, $expected,
+ response_content_is_deeply($request, $expected,
"match data for path `$path' looks good");
}
+
+response_status_is [GET => '/no/hello/bar'] => 404;
11 t/03_route_handler/11_redirect.t
View
@@ -39,5 +39,16 @@ $expected_headers = [
];
response_headers_include [GET => '/redirect_querystring'] => $expected_headers;
+set behind_proxy => 1;
+$ENV{X_FORWARDED_HOST} = "nice.host.name";
+response_headers_include [GET => '/bounce'] => [Location => 'http://nice.host.name/'];
+
+$ENV{HTTP_FORWARDED_PROTO} = "https";
+response_headers_include [GET => '/bounce'] => [Location => 'https://nice.host.name/'];
+
+$ENV{X_FORWARDED_PROTOCOL} = "ftp"; # stupid, but why not?
+response_headers_include [GET => '/bounce'] => [Location => 'ftp://nice.host.name/'];
+
+
Dancer::Logger::logger->{fh}->close;
File::Temp::cleanup();
23 t/03_route_handler/29_forward.t
View
@@ -1,6 +1,6 @@
use strict;
use warnings;
-use Test::More tests => 14, import => ['!pass'];
+use Test::More tests => 16, import => ['!pass'];
use Dancer ':syntax';
use Dancer::Logger;
@@ -14,7 +14,7 @@ Dancer::Logger->init('File');
# checking get
get '/' => sub {
- 'home' . join(',', params);
+ 'home:' . join(',', params);
};
get '/bounce/' => sub {
return forward '/';
@@ -25,21 +25,30 @@ get '/bounce/:withparams/' => sub {
get '/bounce2/adding_params/' => sub {
return forward '/', { withparams => 'foo' };
};
+post '/simple_post_route/' => sub {
+ 'post:' . join(',', params);
+};
+get '/go_to_post/' => sub {
+ return forward '/simple_post_route/', { foo => 'bar' }, { method => 'post' };
+};
response_exists [ GET => '/' ];
-response_content_is [ GET => '/' ], 'home';
+response_content_is [ GET => '/' ], 'home:';
response_exists [ GET => '/bounce/' ];
-response_content_is [ GET => '/bounce/' ], 'home';
+response_content_is [ GET => '/bounce/' ], 'home:';
response_exists [ GET => '/bounce/thesethings/' ];
-response_content_is [ GET => '/bounce/thesethings/' ], 'homewithparams,thesethings';
+response_content_is [ GET => '/bounce/thesethings/' ], 'home:withparams,thesethings';
response_exists [ GET => '/bounce2/adding_params/' ];
-response_content_is [ GET => '/bounce2/adding_params/' ], 'homewithparams,foo';
+response_content_is [ GET => '/bounce2/adding_params/' ], 'home:withparams,foo';
+
+response_exists [ GET => '/go_to_post/' ];
+response_content_is [ GET => '/go_to_post/' ], 'post:foo,bar';
my $expected_headers = [
- 'Content-Length' => 4,
+ 'Content-Length' => 5,
'Content-Type' => 'text/html',
'X-Powered-By' => "Perl Dancer ${Dancer::VERSION}",
];
4 t/05_views/03_layout.t
View
@@ -63,12 +63,12 @@ get '/solo' => sub {
};
get '/full' => sub {
- layout 'main';
+ set layout => 'main';
template 't03';
};
get '/layoutdisabled' => sub {
- layout 'main';
+ set layout => 'main';
template 't03', {}, { layout => undef };
};
44 t/10_template/06_before_template_hook.t
View
@@ -1,44 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 10, import => ['!pass'];
-use Dancer ':syntax';
-use Dancer::Test;
-
-ok(
- before_template sub {
- my $tokens = shift;
- $tokens->{foo} = 'bar';
- }
-);
-
-setting views => path('t', '10_template', 'views');
-
-ok(
- get '/' => sub {
- template 'index', {foo => 'baz'};
- }
-);
-
-route_exists [ GET => '/' ];
-response_content_like( [ GET => '/' ], qr/foo => bar/ );
-
-ok(
- get '/layout_empty_params_passed' => sub {
- layout 'main';
- template 'index', {};
- }
-);
-
-route_exists [ GET => '/layout_empty_params_passed' ];
-response_content_like( [ GET => '/layout_empty_params_passed' ], qr/layout:bar\ncontent:foo => bar/ );
-
-ok(
- get '/layout_but_no_params_passed' => sub {
- layout 'main';
- template 'index';
- }
-);
-
-route_exists [ GET => '/layout_but_no_params_passed' ];
-response_content_like( [ GET => '/layout_but_no_params_passed' ], qr/layout:bar\ncontent:foo => bar/ );
30 t/11_logger/11_runtime_file.t
View
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+
+use File::Temp qw/tempdir/;
+use Test::More tests => 3, import => ['!pass'];
+
+use Dancer;
+use Dancer::FileUtils;
+use Dancer::Test;
+
+my $dir = tempdir(CLEANUP => 1, TMPDIR => 1);
+my $logfile = Dancer::FileUtils::path($dir, "logs", "development.log");
+
+set environment => 'development';
+set appdir => $dir;
+
+set log => 'debug';
+set logger => 'file';
+
+
+get '/' => sub {
+ die "Dieing in route handler - arrggghh!";
+};
+
+response_status_is [GET => '/'], 500 => "We get a 500 answer";
+ok -f $logfile => "Log file got created";
+
+my $logcontents = Dancer::FileUtils::read_file_content($logfile);
+
+like $logcontents => qr/arrggghh!/ => "Log file includes die message";
7 t/14_serializer/17_clear_serializer.t
View
@@ -34,11 +34,8 @@ Test::TCP::test_tcp(
# new request, no serializer
$res = $ua->request($request);
ok( $res->is_success, 'Successful response from server' );
- is_deeply(
- $res->content,
- "$data",
- 'Serializer undef, getting our object back',
- );
+ like($res->content, qr/HASH\(0x.+\)/,
+ 'Serializer undef, response not serialised');
},
server => sub {
1  t/15_plugins/02_config.t
View
@@ -23,6 +23,7 @@ set(environment => 'test' );
my $conffile = Dancer::Config->conffile;
write_file( $conffile => << 'CONF' );
+logger: Null
plugins:
Test:
foo: bar
18 t/22_hooks/00_syntax.t
View
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More import => ['!pass'];
+
+use Dancer ':syntax';
+
+plan tests => 4;
+
+ok( before( sub { 'block before' } ), 'add a before filter' );
+ok( after( sub { 'block after' } ), 'add an after filter' );
+
+ok( before_template( sub { 'block before_template' } ),
+ 'add a before_template filter' );
+
+ok(
+ hook( 'before', sub { 'block before' } ),
+ 'add a before filter using the hook keyword'
+);
23 t/22_hooks/01_api.t
View
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use Test::More import => ['!pass'];
+
+use Dancer ':syntax';
+
+plan tests => 5;
+
+my $cpt = 0;
+
+ok( hook( 'before' => sub { $cpt += shift || 1 }), 'add a before filter');
+
+my $app = Dancer::App->current->name;
+is scalar @{ Dancer::Factory::Hook->instance->get_hooks_for('before') }, 1, 'got one before filter';
+
+my $hooks = Dancer::Factory::Hook->instance->get_hooks_for('before');
+is scalar @$hooks, 1, 'got one before filter';
+
+Dancer::Factory::Hook->instance->execute_hooks('before');
+is $cpt, 1, 'execute hooks without args';
+
+Dancer::Factory::Hook->instance->execute_hooks( 'before', 2 );
+is $cpt, 3, 'execute hooks with one arg';
71 t/22_hooks/02_before.t
View
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+use Test::More import => ['!pass'];
+
+use Dancer ':syntax';
+use Dancer::Test;
+
+plan tests => 15;
+
+my $i = 0;
+
+ok(
+ before(
+ sub {
+ content_type('text/xhtml');
+ }
+ )
+);
+
+ok(
+ before(
+ sub {
+ if ( request->path_info eq '/redirect_from' ) {
+ redirect('/redirect_to');
+ }
+ else {
+ params->{number} = 42;
+ var notice => "I am here";
+ request->path_info('/');
+ }
+ }
+ ),
+ 'before filter is defined'
+);
+
+get(
+ '/' => sub {
+ is( params->{number}, 42, "params->{number} is set" );
+ is( "I am here", vars->{notice}, "vars->{notice} is set" );
+ return 'index';
+ }
+);
+
+get(
+ '/redirect_from' => sub {
+ $i++;
+ }
+);
+
+route_exists [ GET => '/' ];
+response_exists [ GET => '/' ];
+
+my $path = '/somewhere';
+my $request = [ GET => $path ];
+
+route_doesnt_exist $request, "there is no route handler for $path...";
+
+response_exists $request, "...but a response is returned though";
+
+response_content_is $request, 'index',
+ "which is the result of a redirection to /";
+
+response_headers_are_deeply [ GET => '/redirect_from' ],
+ [
+ 'Location' => 'http://localhost/redirect_to',
+ 'Content-Type' => 'text/xhtml',
+ 'X-Powered-By' => "Perl Dancer ${Dancer::VERSION}",
+ ];
+
+is $i, 0, 'never gone to redirect_from';
+
23 t/03_route_handler/26_after_hook.t → t/22_hooks/03_after.t
View
@@ -5,23 +5,22 @@ use Test::More import => ['!pass'];
use Dancer ':syntax';
use Dancer::Test;
-plan tests => 4;
+plan tests => 3;
ok(
- after sub {
- my $response = shift;
- $response->{content} = 'not index!';
- },
+ after(
+ sub {
+ my $response = shift;
+ $response->content('not index!');
+ }
+ ),
'after hook is defined'
);
-ok(
- get(
- '/' => sub {
- return 'index';
- }
- ),
- 'index route is defined'
+get(
+ '/' => sub {
+ return 'index';
+ }
);
route_exists [ GET => '/' ];
38 t/22_hooks/04_template.t
View
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use Test::More tests => 7, import => ['!pass'];
+use Dancer ':syntax';
+use Dancer::Test;
+use Time::HiRes qw/gettimeofday/;
+
+my ( $start, $diff );
+
+ok(
+ before_template sub {
+ my $tokens = shift;
+ $tokens->{foo} = 'bar';
+ ( undef, $start ) = gettimeofday();
+ }
+);
+
+ok(
+ hook after_template_render => sub {
+ my $full_content = shift;
+ like $$full_content, qr/foo => bar/;
+ my ( undef, $end ) = gettimeofday();
+ $diff = $end - $start;
+ }
+);
+
+setting views => path( 't', '22_hooks', 'views' );
+
+get '/' => sub {
+ template 'index', { foo => 'baz' };
+};
+
+route_exists [ GET => '/' ];
+response_content_like( [ GET => '/' ], qr/foo => bar/ );
+
+ok $diff;
+cmp_ok $diff, '>', 0;
35 t/22_hooks/05_layout.t
View
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+
+use Test::More import => ['!pass'];
+use Dancer ':syntax';
+use Dancer::Test;
+
+plan tests => 6;
+
+my $time = localtime();
+
+ok(
+ hook before_layout_render => sub {
+ my $tokens = shift;