#!/usr/bin/perl
use strict;
use lib qw(
/Users/cwinters/work/workflow/lib
/Users/cwinters/work/Class-Factory/lib
/Users/cwinters/work/Class-Observable/lib
);
use App::Web;
use CGI;
use HTTP::Status;
use Log::Log4perl qw( get_logger );
my ( $log );
{
App::Web->init_logger();
App::Web->init_factory();
App::Web->init_url_mappings( 'web_workflow.xml' );
$log = get_logger();
my $cgi = CGI->new();
my $cookie_text = $cgi->raw_cookie;
my $script_name = $cgi->script_name;
my $path_info = $cgi->path_info;
$log->info( "Called script with name '$script_name' and ",
"path '$path_info'" );
my $dispatcher = App::Web->create_dispatcher(
cgi => $cgi,
cookie_text => $cookie_text,
base_url => $cgi->script_name,
);
my ( $action_name ) = $path_info =~ m|^/(\w+)/|;
$log->is_info &&
$log->info( "Found action name '$action_name' from URL" );
# default status
my $status = RC_OK;
# page content goes here
my ( $content );
# hold the template to process here
my ( $template_name );
eval {
if ( $dispatcher->is_dispatchable( $action_name ) ) {
$log->debug( "Action '$action_name' can be dispatched, executing..." );
my $template_name = eval {
$dispatcher->run( $action_name );
};
if ( $@ ) {
$log->error( "Caught error executing '$action_name': $@" );
$dispatcher->param( error_msg => $@ );
$dispatcher->param( action => $action_name );
$status = RC_INTERNAL_SERVER_ERROR;
$template_name = 'error.tmpl';
}
elsif ( my $wf = $dispatcher->param( 'workflow' ) ) {
$log->debug( "Action set 'workflow' in parameters, getting ",
"current actions from it for menu..." );
$dispatcher->param(
available_actions => [ $wf->get_current_actions ] );
}
$content = $dispatcher->process_template( $template_name );
}
elsif ( ! $action_name ) {
$log->debug( "Processing index template since no action given" );
$content = $dispatcher->process_template( 'index.tmpl' );
}
else {
$log->error( "No dispatch found for action '$action_name'" );
$content = "I don't know how to process action '$action_name'.";
$status = RC_NOT_FOUND;
}
};
if ( $@ ) {
$log->error( $@ );
$content = $@;
$status = RC_INTERNAL_SERVER_ERROR;
}
my $cookies_out = $dispatcher->cookie_out_as_objects;
my $header = $cgi->header( -status => $status,
-cookie => $cookies_out );
$log->is_debug && $log->debug( "Sending header to client:\n=====\n$header\n=====" );
print $header, $content;
}
syntax highlighted by Code2HTML, v. 0.9.1