The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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;
}