The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package TestApp;

use strict;


use CGI::Application;
@TestApp::ISA = qw(CGI::Application);


sub setup {
	my $self = shift;

	$self->start_mode('basic_test');

	$self->mode_param('test_rm');

	$self->run_modes(
		'basic_test'		         => \&basic_test,
		'redirect_test'		         => \&redirect_test,
		'cookie_test'		         => \&cookie_test,
		'tmpl_test'		             => \&tmpl_test,
		'tmpl_badparam_test'	     => \&tmpl_badparam_test,
    'props_before_redirect_test' => \&props_before_redirect_test,
    'header_props_twice_nomerge'    => \&header_props_twice_nomerge,
 		'header_add_arrayref_test'		=> \&header_add_arrayref_test,
 		'header_props_before_header_add'		=> \&header_props_before_header_add,
 		'header_add_after_header_props'		=> \&header_add_after_header_props,

    'dump_txt'    => 'dump',
		'eval_test'		=> 'eval_test',
	);

	$self->param('last_orm', 'setup');
}


sub teardown {
	my $self = shift;

	$self->param('last_orm', 'teardown');
}


sub cgiapp_init {
	my $self = shift;
	$self->param('CGIAPP_INIT', 'true');
}



############################
####  RUN MODE METHODS  ####
############################

sub basic_test {
	my $self = shift;

	return "Hello World: basic_test";
}


sub redirect_test {
	my $self = shift;

	$self->header_type('redirect');
	$self->header_props(
		-url => 'http://www.erlbaum.net/'
	);

	return "Hello World: redirect_test";
}


sub cookie_test {
	my $self = shift;
	my $q = $self->query();

	my $cookie = $q->cookie(
		-name => 'c_name',
		-value => 'c_value',
		-path => '/cookie_path_123',
		-domain => 'some.cookie.dom',
		-expires=>'-1y'
	);
	$self->header_props(
		-cookie => $cookie		
	);

	return "Hello World: cookie_test";
}


sub tmpl_test {
	my $self = shift;

	my $t = $self->load_tmpl('test.tmpl');
	$t->param('ping', 'Hello World: tmpl_test');
	
	return $t->output();
}


sub tmpl_badparam_test {
	my $self = shift;

	my $t = $self->load_tmpl('test.tmpl', die_on_bad_params => 0);

	# This tests to see if die_on_bad_params was really turned off!
	$t->param('some_non_existent_tmpl_var', 123);

	$t->param('ping', 'Hello World: tmpl_badparam_test');
	
	return $t->output();
}


sub eval_test {
	my $self = shift;

	die ("No cgi-app object '$self'") unless (ref($self));

	return "Hello World: eval_test OK";
}

sub props_before_redirect_test {
    my $self = shift;

    $self->header_props(
        '-Test'  => 1,
        '-url'   => 'othersite.com',
    );
    $self->header_type('redirect');
	return;
}

sub header_props_twice_nomerge {
    my $self = shift;
    $self->header_props(
        '-Test'  => 1,
        '-Second-header' => 1,
    );

    $self->header_props(
        '-Test'          => 'Updated',
    );
    return 1;
}

sub header_add_arrayref_test {
    my $self = shift;
    $self->header_add(-cookie => ['cookie1=header_add; path=/', 'cookie2=header_add; path=/']);

    return 1;
}

sub header_props_before_header_add {
    my $self = shift;
    $self->header_props(-cookie => 'cookie1=header_props; path=/');
    $self->header_add(-cookie => ['cookie2=header_add; path=/']);

    return 1;
}

sub header_props_after_header_add {
    my $self = shift;
    $self->header_add(-cookie => 'cookie1=header_add; path=/');
    $self->header_props(-cookie => 'cookie2=header_props; path=/');

    return 1;
}

sub header_add_after_header_props {
    my $self = shift;
    $self->header_props(-cookie => 'cookie1=header_props; path=/');
    $self->header_add(-cookie => 'cookie2=header_add; path=/');

    return 1;
}

1;