#!/usr/bin/perl

# $Id: ticket_web.pl 172 2004-09-12 17:00:19Z cwinters $

use strict;
use App::Web;
use CGI;
use CGI::Cookie;
use Cwd               qw( cwd );
use File::Spec::Functions;
use HTTP::Daemon;
use HTTP::Status;
use Log::Log4perl     qw( get_logger );
use Workflow::Factory qw( FACTORY );

App::Web->init_logger();
my $log = get_logger();

$log->info( "Starting web daemon: ", scalar( localtime ) );

App::Web->init_factory();
App::Web->init_url_mappings( 'web_workflow.xml' );

{
    my $d = HTTP::Daemon->new
                || die "Failed to initialize daemon: $!";
    $log->info( "Initialized daemon at URL '", $d->url, "'" );
    print "Please contact me at [URL: ", $d->url, "]\n";
    while ( my $client = $d->accept ) {
        while ( my $request = $client->get_request ) {
            my $response = _handle_request( $client, $request );
            $client->send_response( $response );
        }
        $client->close;
        undef( $client );
    }

    $log->info( "Stopping web daemon: ", scalar( localtime ) );
}

sub _handle_request {
    my ( $client, $request ) = @_;

    my $cookie_header = $request->header( 'Cookie' );
    my $cgi = _create_cgi( $request );
    my $dispatcher = App::Web->create_dispatcher(
        cookie_text => $cookie_header,
        cgi         => $cgi,
    );

    my $url = $request->uri;
    my ( $action ) = $url =~ m|^/(\w+)/|;
    $log->debug( "Trying to dispatch action '$action'" );

    my $status = RC_OK;
    my $content = '';

    if ( $dispatcher->is_dispatchable( $action ) ) {
        $log->debug( "Action '$action' can be dispatched, executing..." );
        my $template_name = eval {
            $dispatcher->run( $action );
        };
        if ( $@ ) {
            $log->error( "Caught error executing '$action': $@" );
            $dispatcher->param( error_msg => $@ );
            $dispatcher->param( action    => $action );
            $status = RC_INTERNAL_SERVER_ERROR;
            $template_name = 'error.tmpl';
        }

        if ( 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 ] );
        }
        $log->debug ( "Processing template '$template_name'..." );
        eval {
            $content = $dispatcher->process_template( $template_name );
        };
        if ( $@ ) {
            $log->error( $@ );
            $content = $@;
            $status = RC_INTERNAL_SERVER_ERROR;
        }
        else {
            $log->debug( "Processed template ok" );
        }
    }
    elsif ( ! $action ) {
        $log->debug( "Processing index template since no action given" );
        $content = $dispatcher->process_template( 'index.tmpl' );
    }
    else {
        $log->error( "No dispatch found for action '$action'" );
        $content = "I don't know how to process action '$action'.";
        $status = RC_NOT_FOUND;
    }

    my $response = HTTP::Response->new( $status );
    $response->header( 'Content-Type' => 'text/html' );
    $response->content( $content );
    $response->header( 'Set-Cookie' => $dispatcher->cookie_out_as_objects );
    return $response;
}


########################################
# PARAMETER PARSING

sub _create_cgi {
    my ( $request ) = @_;
    my $method = $request->method;
    my $content_type = $request->content_type;
    if ( $method eq 'GET' || $method eq 'HEAD' ) {
        return CGI->new( $request->uri->equery );
    }
    elsif ( $method eq 'POST' ) {
        if ( ! $content_type
                 || $content_type eq "application/x-www-form-urlencoded" ) {
            return CGI->new( $request->content );
        }
    }
    die "Unsupported [Method: $method] [Content Type: $content_type]";
}



syntax highlighted by Code2HTML, v. 0.9.1