Apache-SWIT

 view release on metacpan or  search on metacpan

lib/Apache/SWIT.pm  view on Meta::CPAN

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

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

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

=cut
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);

lib/Apache/SWIT/LargeObjectHandler.pm  view on Meta::CPAN

	($ct, $buf) = HTML::Tested::ClassDBI::Upload->strip_mime_header($buf) if (!$ct);
	confess "No content type found!" unless $ct;
	$r->headers_out->add('Expires', HTTP::Date::time2str(
				time + 240*24*60*60));
	$class->swit_send_http_header($r, $ct);
	do {
		$r->print($buf);
	} while ($dbh->func($lo_fd, $buf, $bufsiz, 'lo_read'));
}

sub swit_render_handler($$) {
	my($class, $ar) = @_;
	my $r = Apache2::Request->new($ar);
	my $enc_loid = $r->param("loid") or confess "No loid was given";
	my $loid = HTML::Tested::Seal->instance->decrypt($enc_loid)
			or confess "Unable to decrypt loid: $enc_loid";
	my $dbh = Apache::SWIT::DB::Connection->instance->db_handle;
	$dbh->begin_work;
	eval { $class->serve_lo($r, $dbh, $loid, 4096 * 4); };
	if ($@) {
		$dbh->rollback;

lib/Apache/SWIT/Session.pm  view on Meta::CPAN

use strict;
use warnings FATAL => 'all';

package Apache::SWIT::Session;
use Storable qw(thaw freeze);
use HTML::Tested::Seal;

sub access_handler($$) {
	my ($class, $r) = @_;
	my $session = $class->begin($r);
	$r->pnotes("SWITSession", $session);
	return Apache2::Const::OK();
}

sub begin {
	my ($class, $r) = @_;
	my %args = (_request => $r);
	my %cookies = Apache2::Cookie->fetch($r);

lib/Apache/SWIT/Test/ResetKids.pm  view on Meta::CPAN

use strict;
use warnings FATAL => 'all';

package Apache::SWIT::Test::ResetKids;
use File::Slurp;
use Apache::SWIT::Test::Utils;

sub access_handler($$) {
	my ($class, $r) = @_;
	my $kfile = ASTU_Module_Dir() . "/t/logs/kids_are_clean.$$";
	goto OUT if -f $kfile;
	Apache::SWIT::DB::Connection->instance->db_handle->{CachedKids} = {};
	write_file($kfile, "");
OUT:
	return Apache2::Const::OK();
}

1;

t/T/Invalid.pm  view on Meta::CPAN

sub swit_invalid_request {
	my ($class, $r) = @_;
	return [ Apache2::Const::OK, qr/Invalid handler called/ ];
}

sub _raw_respond {
	my ($class, $r, $to) = @_;
	return $class->SUPER::_raw_respond($r->{req}, $to);
}

sub invalid_handler($$) {
	my ($class, $r) = @_;
	return $class->swit_update_handler({ req => $r });
}

1;

t/T/SWIT.pm  view on Meta::CPAN

		return [ Apache2::Const::OK, 'This is RESPONSE' ];
	} elsif ($f =~ /CTYPE/) {
		return [ Apache2::Const::OK, undef, 'text/plain' ];
	} else {
		write_file($f, $r->param('but') || '');
		write_file("$f.uri", $r->uri);
	}
	return '/test/res/r?res=hhhh';
}

sub ct_handler($$) {
	my ($class, $r) = @_;
	# check that session has our request
	my $rs = $r->pnotes('SWITSession')->request;
	return Apache2::Const::FORBIDDEN if $r->uri ne $rs->uri;
	$class->swit_send_http_header($r, "text/plain");

	# check that we have no session anymore
	return Apache2::Const::FORBIDDEN if $r->uri ne $rs->uri;
	return Apache2::Const::OK;
}