Apache::SWIT - mod_perl based application server with integrated testing.

Apache-SWIT documentation Contained in the Apache-SWIT distribution.

Index

Code Index:

NAME

Top

Apache::SWIT - mod_perl based application server with integrated testing.

SYNOPSIS

Top

	package MyHandler;
	use base 'Apache::SWIT';

	# overload render routine
	sub swit_render {
		my ($class, $r) = @_;
		return ({ hello => 'world' }, 'my_template.tt');
		# or return { hello => 'world' }; to rely on swit.yaml
		# based generation
	}

	# overload update routine, usually result of POST
	sub swit_update {
		my ($class, $r) = @_;
		# do some work ...
		# and redirect to another page
		return '/redirect/to/some/url';
	}

DISCLAIMER

Top

This is pre-alpha quality software. Please use it on your own risk.

DESCRIPTION

Top

This module serves as yet another mod_perl based application server.

It tries to capture several often occuring paradigms in mod_perl development. It provides user with the tools to bootstrap a new project, write tests easily, etc.

METHODS

Top

$class->swit_send_http_header($r, $ct)

Sends HTTP default headers: session cookie and content type. $r is apache request and $ct is optional content type (defaults to text/html; charset=utf-8.

$class->swit_die($msg, $r, @data_to_dump)

Dies with first line of $msg using Carp::croak and dumps request $r and @data_to_dump with Data::Dumper into /tmp/swit_<time>.err file.

swit_post_max

Maximal size of POST request. Default is 1M. Overload it to return something else.

$class->swit_update_handler($class, $r)

Entry point for an update handler. Calls $class->swit_update($apr) function with Apache2::Request parameter. The result of swit_update henceforth is called $to is passed down.

If $to is regular string then 302 status is produced with Location equal to $to.

If $to is array reference and first item is a number then the status with $to-[0]> is produced and $to->[1] is returned as response body. $to->[2] may by used as content type.

I.e. [ 200, "Hello", "text/plain" ] will respond with 200 OK status and Hello as a body with text/plain as content type.

The first item can also be INTERNAL magic string. In that case internal redirect to the second array item is produced.

Of $to parameters only $to->[0] is mandatory.

BUGS

Top

Much needed documentation is non-existant at the moment.

AUTHOR

Top

	Boris Sukholitko
	boriss@gmail.com

COPYRIGHT

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

SEE ALSO

Top

HTML::Tested

Apache-SWIT documentation Contained in the Apache-SWIT distribution. 
use strict;
use warnings FATAL => 'all';

package Apache::SWIT;
use Carp;
use Data::Dumper;
use File::Slurp;

our $VERSION = 0.54;

sub swit_startup {}


sub swit_send_http_header {
	my ($class, $r, $ct) = @_;
	$r->pnotes('SWITSession')->end;
	$r->pnotes('SWITSession', undef);
	$r->content_type($ct || "text/html; charset=utf-8");
}


sub swit_die {
	my ($class, $msg, $r, @more) = @_;
	my $err = (split(/\n/, $msg))[0];
	my $f = "/tmp/swit_" . time . ".err";
	write_file($f, "$msg with request:\n" . $r->as_string . "and more:\n"
			. join("\n", map { Dumper($_) } @more));
	croak "In $f $err";
}

sub _raw_respond {
	my ($class, $r, $to) = @_;
	my $s = ref($to) ? $to->[0] : Apache2::Const::REDIRECT();
	if ($s eq 'INTERNAL') {
		$r->pnotes("PrevRequestSuppress", $to->[2]) if $to->[2];
		$r->headers_in->unset("Content-Length");
		$r->internal_redirect($r->uri . "/../" . $to->[1]);
		return Apache2::Const::OK();
	}
	$r->headers_out->add(Location => $to) unless ref($to);
	$class->swit_send_http_header($r, ref($to) ? $to->[2] : undef);
	$r->print($to->[1]) if (ref($to) && defined($to->[1]));
	return $s;
}


sub swit_post_max { return '1000000'; }

sub swit_invalid_request {
	my ($class, $r, $err) = @_;
	die "Invalid request: $err";
}


sub swit_update_handler($$) {
	my ($class, $r) = @_;
	my $ar;
	# Sometimes request fails - cannot find a testcase though...
	eval { $ar = Apache2::Request->new($r
			, POST_MAX => $class->swit_post_max); };
	my $to = $@ ? $class->swit_invalid_request($r, $@)
				: $class->swit_update($ar);
	return $class->_raw_respond($r, $to);
}

our $TEMPLATE;

sub swit_process_template {
	my ($class, $r, $file, $vars) = @_;
	my $out;
	$TEMPLATE->process($file, $vars, \$out) or $class->swit_die(
			"No result for $file\: " . $TEMPLATE->error, $r);
	return $out;
}

sub swit_render_handler($$) {
	my ($class, $r) = @_;
	$r->pnotes('SWITTemplate', $r->dir_config('SWITTemplate'));
	my $ar = Apache2::Request->new($r);
	my $vars = $class->swit_render($ar);
	return $class->_raw_respond($ar, $vars) if (ref($vars) ne 'HASH');

	my $file = $r->pnotes('SWITTemplate') or confess "No template file";
	$vars->{request} = $r unless exists $vars->{request};
	my $out = $class->swit_process_template($r, $file, $vars);
	$class->swit_send_http_header($r);
	$r->print($out);
	return Apache2::Const::OK();
}

sub swit_schedule {
	my ($class, $r, $worker, @msgs) = @_;
	my $dbh = Apache::SWIT::DB::Connection->instance->db_handle;
	$worker->enqueue($dbh, $_) for @msgs;
	$r->pool->cleanup_register(sub {
		$worker->new->run($dbh);
	});
}

sub swit_failure {
	my ($class, @res) = @_;
	return [ 'INTERNAL', shift @res, \@res ];
}

1;