Apache-SWIT

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

t/590_sub_scaffold.t
t/910_self_install.t
t/conf/extra.conf.part
t/conf/do_swit_startups.pl
t/apache_test.pl
t/apache/001_basic.t
t/apache/010_tester.t
t/apache/020_ht_page.t
t/apache/030_sess_page.t
t/apache/040_transactions.t
t/apache/050_validate.t
t/apache/060_guitest.t
t/apache/070_unicode.t
t/apache/080_upload.t
t/apache/090_redirect.t
t/apache/100_worker.t
t/T/Redirect.pm
t/T/Test.pm
t/T/Upload.pm
t/T/Basic.pm
t/T/SWIT.pm

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

	goto EXCEPTION if $err;
	return $res;

ROLLBACK:
	eval { $dbh->rollback };
	$err .= "\nRollback exception: $@" if $@;
EXCEPTION:
	return $class->ht_swit_die('ht_swit_update_die', $err, $r, $tested);
}

sub ht_swit_validate_die {
	my ($class, $errs, $r, $root) = @_;
	$class->swit_die("ht_validate failed", $r, $root, $errs);
}

sub swit_update {
	my ($class, $r) = @_;
	my %args = %{ $r->param || {} };
	if ($r->body_status eq 'Success') {
		$args{ $r->upload($_)->name } = $r->upload($_) for $r->upload;
	}
		
	my $tested = $class->ht_root_class->ht_load_from_params(%args);
	my @errs = $tested->ht_validate;
	return $class->ht_swit_die('ht_swit_validate_die', \@errs, $r, $tested)
			if @errs;
	return $class->ht_swit_transactional_update($r, $tested, \%args);
}

1;

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

sub _encode_errors {
	return shift()->swit_encode_errors(@_);
}

sub swit_encode_errors {
	my ($class, $errs) = @_;
	my $es = $class->ht_root_class->ht_encode_errors(@$errs);
	return "r?swit_errors=$es";
}

sub ht_swit_validate_die {
	my ($class, $errs, $r, $root) = @_;
	return $class->swit_encode_errors($errs);
}

sub ht_swit_update_die {
	my ($class, $msg, $r, $root) = @_;
	my ($uq) = ($msg =~ /unique constraint "(\w+)"/);
	goto ORIG_ERROR unless $uq;

	my $dbh = Apache::SWIT::DB::Connection->instance->db_handle;

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

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

package T::HTError::Root;

sub ht_validate {
	my $n = shift()->name;
 	return  $n eq 'bad' || $n eq 'foo' ? ('bad') : ();
}

package T::HTError;
use base 'Apache::SWIT::HTPage';
use HTML::Tested qw(HTV);
use HTML::Tested::Value::PasswordBox;

sub swit_startup {

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

	$rc->ht_add_widget(HTV, 'error');
	$rc->ht_add_widget(::HTV."::Form", form => default_value => 'u');
}

sub ht_swit_render {
	my ($class, $r, $root) = @_;
	$root->name("buh");
	return $root;
}

sub ht_swit_validate_die {
	my ($class, $errs, $r, $root) = @_;
	my $res = $root->name eq 'foo' ? "r?error=validate"
			: "r?error=validie&error_uri=" . $r->uri;
	return ($res, 'password');
}

sub ht_swit_update_die {
	my ($class, $msg, $r, $root) = @_;
	return $class->SUPER::swit_die(@_) unless $msg =~ /Hoho/;
	return ("r?error=updateho", "password");
}

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

__PACKAGE__->ht_add_widget(::HTV."::Upload", the_upload => cdbi_upload =>
				'loid');
__PACKAGE__->ht_add_widget('T::Upload::Image', mime_upload =>
		cdbi_upload_with_mime => 'loid');
__PACKAGE__->ht_add_widget(::HTV, loid => is_sealed => 1 => cdbi_bind => ''
				, cdbi_readonly => 1, skip_undef => 1);
__PACKAGE__->ht_add_widget(::HTV."::Form", form => default_value => 'u');
__PACKAGE__->ht_add_widget(::HTV."::EditBox", "val");
__PACKAGE__->bind_to_class_dbi("T::Upload::DB");

sub ht_validate { return (); }

package T::Upload;
use base 'Apache::SWIT::HTPage';

sub ht_swit_render {
	my ($class, $r, $root) = @_;
	$root->cdbi_load;
	return $root;
}

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

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

package T::ValidateFailure::Root;
use base 'HTML::Tested';

sub ht_validate { return qw(hoho); }

package T::ValidateFailure;
use base 'Apache::SWIT::HTPage';
use File::Slurp;

sub ht_swit_render {
	my ($class, $r, $root) = @_;
	my $a;
	my $should_die_here = $a . "a";
	return $root;
}

sub ht_swit_update {
	my ($class, $r) = @_;
	write_file("/tmp/apache_swit_validate_failure", "");
	return "r";
}

1;

t/apache/050_validate.t  view on Meta::CPAN

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

use Test::More tests => 9;
use Apache::SWIT::Session;

BEGIN { use_ok('T::Test');
	use_ok('T::ValidateFailure');
};

unlink "/tmp/apache_swit_validate_failure";

my $t = T::Test->new({ session_class => 'Apache::SWIT::Session' });
$t->root_location('/test');
$t->ok_get('invalid/u');
like($t->mech->content, qr/Invalid handler called/);

$ENV{SWIT_HAS_APACHE} = 0;
T::Test->make_aliases(validate_fail => 'T::ValidateFailure');

$t = T::Test->new({ session_class => 'Apache::SWIT::Session' });
eval { $t->ht_validate_fail_u(ht => {}); };
like($@, qr/ht_validate failed/); 
like($@, qr/Request/);
is(-f "/tmp/apache_swit_validate_failure", undef);

eval { $t->ht_validate_fail_r(ht => {}); };
like($@, qr/Request/);
like($@, qr/uninitialized/);

t/apache/090_redirect.t  view on Meta::CPAN

is($t->mech->status, 200);

T::Test->make_aliases(ht_error => 'T::HTError', another_page => 'T::HTPage');

$t->ok_ht_ht_error_r(make_url => 1, ht => { name => "buh", error => ""
		, password => "" });
$t->ht_ht_error_u(ht => { name => "foo", password => "boo" });

# we should not see password going back. Even if its incorrect.
$t->ok_ht_ht_error_r(ht => { name => "foo", password => ""
		, error => "validate" }) or ASTU_Wait;

$t->ht_ht_error_u(ht => { name => "swid", password => "hru" });
$t->ok_ht_ht_error_r(ht => { name => "swid", error => "updateho"
		, password => "" });

$t->ht_ht_error_u(ht => { name => "bad", password => "hru" });
$t->ok_ht_ht_error_r(ht => { name => "bad", error => "validie"
		, password => "" });

$t->ht_ht_error_u(ht => { name => "fail", password => "hru" });