http-webtest-commits

[Ilya M. <m_...@us...>]

Update of /cvsroot/http-webtest/HTTP-WebTest-Recorder/lib/HTTP/WebTest/Recorder
In directory sc8-pr-cvs1:/tmp/cvs-serv26219/lib/HTTP/WebTest/Recorder

Added Files:
	Exceptions.pm Controller.pm Action.pm 
Log Message:
Move everything in HTTP::WebTest::Recorder namespace


--- NEW FILE: Exceptions.pm ---
package HTTP::WebTest::Recorder::Exceptions;

use strict;

my %EXC;

BEGIN {
    %EXC = ( HTTP::WebTest::Recorder::Exception =>
	     { description =>
	       'Generic base class for all Investion exceptions' },

	     HTTP::WebTest::Recorder::Exception::Redirect =>
	     { isa         => 'HTTP::WebTest::Recorder::Exception',
               fields      => [ 'url' ],
	       description =>  'Redirect message' },
           );
}

use Exception::Class %EXC;

{
    package HTTP::WebTest::Recorder::Exception;

    # have nice stack trace output
    sub as_string {
	my $self = shift;

	my $str = $self->full_message;
	chomp $str;
	if(exists $self->{show_trace} ? $self->{show_trace} : $self->Trace) {
	    $str .= "\n\n\n" . $self->_stack_trace . "\n\n";
	}

	return $str;
    }

    sub _stack_trace {
	my $self = shift;

	my $str = '';
	while(my $frame = $self->trace->next_frame) {
	    next if $frame->subroutine eq 'Exception::Class::Base::throw';

	    my $args = join ', ', map defined $_ ? "'$_'" : 'undef', $frame->args;

	    $str .= '  [' . $frame->filename . ':' . $frame->line . '] ';
	    $str .= $frame->subroutine . "($args)\n";
	}

	return $str;
    }
}

1;

--- NEW FILE: Controller.pm ---
package HTTP::WebTest::Recorder::Controller;

# $Id: Controller.pm,v 1.1 2003/01/25 14:54:52 m_ilya Exp $

use strict;

use CGI;
use File::Spec;
use HTTP::Status;
use HTTP::WebTest::Utils qw(make_access_method);
use Template;

use HTTP::WebTest::Recorder::Exceptions;

# constructor
sub new {
    my $class = shift;
    my $self = bless {}, $class;
    return $self;
}

# recorder object
*recorder = make_access_method('RECORDER');
# template toolkit object
*template = make_access_method('TEMPLATE', 'create_template');
# view (template filename)
*view = make_access_method('VIEW');
# cgi object
*cgi = make_access_method('CGI');
# request object
*request = make_access_method('REQUEST');

use vars qw(%DISPATCH);

%DISPATCH = (list     => 'HTTP::WebTest::Recorder::Action::List',
             request  => 'HTTP::WebTest::Recorder::Action::Request',
             wtscript => 'HTTP::WebTest::Recorder::Action::WTScript',
             enable   => 'HTTP::WebTest::Recorder::Action::Enable',
             default  => 'HTTP::WebTest::Recorder::Action');

# serves requests for web interface of the proxy
sub execute {
    my $self = shift;
    my %param = @_;

    # init controller with request data
    $self->recorder($param{recorder});
    $self->request($param{request});
    $self->cgi($self->create_cgi($param{request}));
    $self->view($param{action});

    my $action_package = $DISPATCH{$param{action}} || $DISPATCH{default};
    eval "require $action_package";
    my $action = $action_package->new;

    my $response;
    eval {
        $response = $self->process_template($action->execute($self));
    };
    if($@) {
        if($@->isa('HTTP::WebTest::Recorder::Exception::Redirect')) {
            $response = HTTP::Response->new(RC_FOUND);
            $response->header(Location => $@->url);
        } else {
            $@->rethrow;
        }
    };
    $response->header(Pragma => 'No-Cache');
    return $response;
}

# populates template with data returned by action object and generates
# response based on template output
sub process_template {
    my $self = shift;
    my %data = @_;

    my $content = '';
    if($self->template->process($self->view, \%data, \$content)) {
        my $response = HTTP::Response->new(RC_OK);
        $response->header(Content_Type => 'text/html');
        $response->content($content);
        return $response;
    } elsif($self->template->error =~ /file error - .*: not found/) {
        my $response = HTTP::Response->new(RC_NOT_FOUND);
        $response->header(Content_Type => 'text/plain');
        $response->content('Not Found');
        return $response;
    } else {
        my $response = HTTP::Response->new(RC_INTERNAL_SERVER_ERROR);
        $response->header(Content_Type => 'text/plain');
        $response->content($self->template->error);
        return $response;
    }
}

# generates redirect exception
sub redirect {
    my $self = shift;
    my $url = shift;

    HTTP::WebTest::Recorder::Exception::Redirect->throw(message => 'Redirect',
                                                        url => $url);
}

# create CGI object from HTTP request object
sub create_cgi {
    my $self = shift;
    my $request = shift;

    my $query = '';
    if($request->method eq 'GET') {
        $query = $request->uri->query;
    } elsif($request->method eq 'POST') {
        $query = $request->content;
    }

    return CGI->new($query);
}

# creates template toolkit object
sub create_template {
    my $self = shift;

    # search template files in standart Perl include directories
    my @template_dir = qw(HTTP WebTest Recorder template);
    my $include_path = (join ':',
                        map File::Spec->catdir($_, @template_dir),
                        @INC);
    return Template->new(INCLUDE_PATH => $include_path);
}

1;

--- NEW FILE: Action.pm ---
package HTTP::WebTest::Recorder::Action;

# $Id: Action.pm,v 1.1 2003/01/25 14:54:52 m_ilya Exp $

use strict;

# constructor
sub new {
    my $class = shift;
    my $self = bless {}, $class;
    return $self;
}

# serves requests
sub execute {
    my $self = shift;
    my $controller = shift;

    return(action     => $self,
           controller => $controller);
}

1;