# $Id: TestApp.pm,v 1.5 2002/07/18 11:50:20 jesse Exp $
package TestAppX;
use strict;
; use CGI::Builder
qw| CGI::Builder::CgiAppAPI
|
;
package TestApp;
use strict;
; use CGI::Builder
qw| CGI::Builder::CgiAppAPI
|
;
#$CGI::Builder::CgiAppAPI::hints = 1 ;
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,
'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";
}
1;