view release on metacpan or  search on metacpan

t/70dancer2.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use version;

use JSON::MaybeXS;
use Test::More;

BEGIN {
	eval "require Dancer2";
	plan skip_all => 'Dancer2 is not installed'
		if $@;

	plan skip_all => "Dancer2 is too old: $Dancer2::VERSION"
		if version->parse($Dancer2::VERSION) <= 0.207;   # for to_app()

	warn "Dancer2 version $Dancer2::VERSION\n";

	eval "require Plack::Test";
	$@ and plan skip_all => 'Unable to load Plack::Test';

	eval "require HTTP::Cookies";
	$@ and plan skip_all => 'Unable to load HTTP::Cookies';

	eval "require HTTP::Request::Common";
	$@ and plan skip_all => 'Unable to load HTTP::Request::Common';
	HTTP::Request::Common->import;

	eval "require Dancer2::Session::Sereal";
	$@ and plan skip_all => 'Unable to load Dancer2::Session::Sereal';

	plan tests => 4;
}

{
	package TestApp;
	use Dancer2;

	use Dancer2::Plugin::LogReport 'test_app';

	# Default Sereal session config is to refuse objects
	set engines => {
		session => {
		    Sereal => {
		        encoder_args => {
		            croak_on_bless => 0,
		            # Messages from later versions of Log::Report do not
		            # serialize cleanly. Therefore use the object's freeze and
		            # thaw methods.
		            freeze_callbacks => 1,
		        },
		        decoder_args => {
		            refuse_objects => 0,
		        },
		    },
		},
	};

	# Check that messages can be serialized as objects. Use the Sereal session
	# serializer, as it's the easiest to configure to enable blessed objects in
	# its serialization
	set session => 'Sereal';
	set logger  => 'LogReport';

	# Configure at least 2 dispatchers so that the message domain becomes an
	# object. Don't use the default dispatcher though, to prevent noise being
	# printed during the tests
	dispatcher close => 'default';
	dispatcher FILE => 'stderr', to => '/dev/null';

	# Whether to bork on the root URL
	our $always_bork_before;
	our $always_bork_after;

	hook before => sub {
		if ($always_bork_before || query_parameters->get('hook_before_exception'))
		{
		    my $foo;
		    $foo->bar;
		}
	};

	hook after => sub {
		if ($always_bork_after || query_parameters->get('hook_after_exception'))
		{
		    my $foo;
		    $foo->bar;
		}
	};

	# Unhandled exception in default route
	get '/' => sub {
		my $foo;
		$foo->bar;
	};

	get '/write_message/:level/:text/:param?' => sub {
		# Allow a message to be raised with a level, text and optional
		# parameter
		my $level = param('level');
		my $text  = param('text');
		my $param = param('param');
		$text    .= " {param}" if $param;
		my $eval  = qq($level __x"$text");
		$eval    .= qq(, param => "$param") if $param;
		eval $eval;
	};

	get '/read_message' => sub {
		my $all  = session 'messages';