view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN

{
  my $app = eval { TestApp->new(PARAMS => [ 1, 2, 3, ]); };

  like($@, qr/not a hash ref/, "PARAMS must be a hashref!");
}

# run() CGI::Application sub-class, in run mode 'redirect_test'.
# Expect HTTP redirect header + 'Hello World: redirect_test'.
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'redirect_test'}));

	response_like(
		$app,
		qr/^Status: 302/,
		qr/Hello World: redirect_test/,
		'TestApp, redirect_test'
	);
}


# run() CGI::Application sub-class, in run mode 'redirect_test'.
# Expect HTTP redirect header + 'Hello World: redirect_test'.
# ...just like the test above, but we pass QUERY in via a hashref.
{
	my $app = TestApp->new({
    QUERY => CGI->new({'test_rm' => 'redirect_test'})
  });

	response_like(
		$app,
		qr/^Status: 302/,
		qr/Hello World: redirect_test/,
		'TestApp, redirect_test'
	);
}

# run() CGI::Application sub-class, in run mode 'dump_text'.
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'dump_txt'}));

	response_like(
		$app,
		qr{^Content-type: text/html}i,
		qr/Query Environment/,
		'TestApp, dump_text'
	);
}


# run() CGI::Application sub-class, in run mode 'cookie_test'. 
# Expect HTTP header w/ cookie:
#	 'c_name' => 'c_value' + 'Hello World: cookie_test'.
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'cookie_test'}));

	response_like(
		$app,
		qr/^Set-Cookie: c_name=c_value/,
		qr/Hello World: cookie_test/,
		"TestApp, cookie test",
	);
}


# run() CGI::Application sub-class, in run mode 'tmpl_test'. 
# Expect HTTP header + 'Hello World: tmpl_test'.
{
	my $app = TestApp->new(TMPL_PATH=>'t/lib/templates/');
	$app->query(CGI->new({'test_rm' => 'tmpl_test'}));

	response_like(
		$app,
		qr{^Content-Type: text/html},
		qr/---->Hello World: tmpl_test<----/,
		"TestApp, tmpl_test",
	);
}


# run() CGI::Application sub-class, in run mode 'tmpl_badparam_test'.
# Expect HTTP header + 'Hello World: tmpl_badparam_test'.
{
	my $app = TestApp->new(TMPL_PATH=>'t/lib/templates/');
	$app->query(CGI->new({'test_rm' => 'tmpl_badparam_test'}));

	response_like(
		$app,
		qr{^Content-Type: text/html},
		qr/---->Hello World: tmpl_badparam_test<----/,
		"TestApp, tmpl_badparam_test",
	);
}


# Instantiate and call run_mode 'eval_test'.	Expect 'eval_test OK' in output.
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'eval_test'}));

	response_like(
		$app,
		qr{^Content-Type: text/html},
		qr/Hello World: eval_test OK/,
		"TestApp, eval_test",
	);
}

# Test to make sure cgiapp_init() was called in inherited class.
{
	my $app = TestApp2->new();
	my $init_state = $app->param('CGIAPP_INIT');
	ok(defined($init_state), "TestApp2's cgiapp_init ran");
	is($init_state, 'true', "TestApp2's cgiapp_init set the right value");
}


# Test to make sure mode_param() can contain subref
{

t/basic.t  view on Meta::CPAN

		'P5' => 'new five',
		'P6' => 'six',
		'P7' => 'seven',
	});
	@plist = sort $app->param();
	is_deeply(\@plist, ['P1', 'P2', 'P3', 'P4', 'P5', 'P6', 'P7'], "7 params ok");
	is($app->param("P$_"), $params[$_], "P$_ of 7 correct") for 1..7;
	ok(not(defined($pt4val)), "multiple param setting returns undef (for now)");

	# What about a simple pass-through?	(Should return param value)
	my $pt5val = $app->param('P8', 'eight');
	@plist = sort $app->param();
	is_deeply(\@plist, [qw(P1 P2 P3 P4 P5 P6 P7 P8)], "P1-8 all ok");
	is($app->param("P$_"), $params[$_], "P$_ of 8 correct") for 1..8;
	is($pt5val, 'eight', "value returned on setting P8 is correct");
}


# test undef param values
{
  my $app = TestApp->new();

  $app->param(foo => 10);

  is(
    $app->delete,
    undef,
    "we get undef when deleting unnamed param",
  );

  is($app->param('foo'), 10, q(and our real param is still ok));
}

# test setting header_props before header_type 
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'props_before_redirect_test'}));
	my $output = $app->run();

	like($output, qr/test: 1/i, "added test header before redirect");
	like($output, qr/Status: 302/, "and still redirected");
}

# testing setting header_props more than once
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'header_props_twice_nomerge'}));
	my $output = $app->run();

	like($output, qr/test: Updated/i, "added test header");
	unlike($output, qr/second-header: 1/, "no second-header header");
	unlike($output, qr/Test2:/, "no Test2 header, either");
}

# testing header_add with arrayref
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'header_add_arrayref_test'}));
	my $output = $app->run();

	like($output, qr/Set-Cookie: cookie1=header_add/, "arrayref test: cookie1");
	like($output, qr/Set-Cookie: cookie2=header_add/, "arrayref test: cookie2");
}

# make sure header_add does not clobber earlier headers
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'header_props_before_header_add'}));
	my $output = $app->run();

	like($output, qr/Set-Cookie: cookie1=header_props/, "header_props: cookie1");
	like($output, qr/Set-Cookie: cookie2=header_add/,   "header_add: cookie2");
}

# make sure header_add works after header_props is called
{
	my $app = TestApp->new();
	$app->query(CGI->new({'test_rm' => 'header_add_after_header_props'}));
	my $output = $app->run();

	like($output, qr/Set-Cookie: cookie2=header_add/, "header add after props");
}

# test use of TMPL_PATH without trailing slash
{
	my $app = TestApp->new(TMPL_PATH=>'t/lib/templates');
	$app->query(CGI->new({'test_rm' => 'tmpl_badparam_test'}));

	response_like(
		$app,
		qr{^Content-Type: text/html},
		qr/---->Hello World: tmpl_badparam_test<----/,
		"TMPL_PATH without trailing slash",
	);
}


# If called "too early" we get undef for current runmode.
{
  my $app = CGI::Application->new;

  eval { $app->run_modes('whatever') };

  like($@, qr/odd number/i, "croak on odd number of args to run_modes");
}


# If called "too early" we get undef for current runmode.
{
  my $app = CGI::Application->new;
  is($app->get_current_runmode, undef, "current runmode is undef before run");
  
  my $dump = $app->dump;
  like($dump, qr/^Current Run mode: ''\n/, "no current run mode in dump");
}


# test delete() method by first setting some params and then deleting them
{
	my $app = TestApp5->new();
	$app->param(
		P1 => 'one',
		P2 => 'two',
		P3 => 'three'
	);

	is_deeply(
		[ sort $app->param ],
		[ qw(P1 P2 P3) ],
		"we start with P1 P2 P3",
	);

	#a valid delete
	my $p2value = $app->delete('P2');
	my @params = sort $app->param();

	is_deeply(\@params, ['P1', 'P3'], "P2 deletes without incident");
	is($p2value, "two", "and deletion returns the deleted value");

	is($app->param('P1'), 'one', 'P1 still has the right value');