Apache-SWIT
view release on metacpan or search on metacpan
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
t/T/TransFailure.pm
t/T/ValidateFailure.pm
t/T/DBPage.pm
t/T/Res.pm
t/T/Empty.pm
t/T/HTPage.pm
t/T/HTError.pm
t/templates/ht_error.tt
t/T/Session.pm
t/T/SessPage.pm
t/templates/more.tt
t/templates/empty_up.tt
t/templates/upload.tt
t/templates/test.tt
t/templates/res.tt
t/templates/htpage.tt
t/templates/sess_page.tt
t/templates/db_page.tt
t/public_html/hello.html
Makefile.PL
META.yml
lib/Apache/SWIT/HTPage.pm view on Meta::CPAN
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/Test.pm view on Meta::CPAN
$handler_class->ht_root_class, $r, $args{ht});
$args{fields} = $r->_param;
delete $args{ht};
delete $args{param};
if (my $form_number = $args{'form_number'}) {
$self->mech->form_number($form_number) or confess "No number";
} elsif (my $form_name = $args{'form_name'}) {
$self->mech->form_name($form_name) or confess "No form_name";
}
goto OUT unless $r->upload;
my $form = $self->mech->current_form or confess "No form found!";
confess "Form method is not POST" if uc($form->method) ne "POST";
confess "Form enctype is not multipart/form-data"
if $form->enctype ne "multipart/form-data";
for my $u (map { $r->upload($_) } $r->upload) {
my $i = $self->mech->current_form->find_input($u->name)
or die "Unable to find input for " . $u->name;
if ($i->can('content')) {
my $c = read_file($u->fh);
$i->content($c);
$i->filename($u->filename);
} else {
# Mozilla::Mechanize::Input
$i->{input}->SetValue($u->filename);
}
t/T/HTPage.pm view on Meta::CPAN
$root->hello('world');
$root->req_uri($r->uri);
$root->hid($root->hid || 'secret');
$root->hostport($ENV{APACHE_SWIT_SERVER_URL});
return $root;
}
sub ht_swit_update {
my ($class, $r, $root) = @_;
my $f = $root->file or die "No file is given";
my $up = $r->upload('up');
my $res = $up ? $up->filename : "0";
write_file($f, "$res\n" . read_file($root->up));
return '/test/basic_handler';
}
sub swit_startup {
my $hclass = shift()->ht_root_class;
$hclass->ht_add_widget(HTV, 'hello');
$hclass->ht_add_widget(HTV, 'req_uri');
$hclass->ht_add_widget(HTV, 'v1');
t/T/Upload.pm view on Meta::CPAN
package T::Upload::DB;
use base 'Apache::SWIT::DB::Base';
__PACKAGE__->set_up_table('upt');
package T::Upload::Root;
use base 'HTML::Tested::ClassDBI';
use HTML::Tested qw(HTV);
__PACKAGE__->ht_add_widget(::HTV, id => is_sealed => 1
=> cdbi_bind => 'Primary');
__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';
t/T/Upload.pm view on Meta::CPAN
$root->cdbi_load;
return $root;
}
sub swit_post_max { return '20000'; }
sub ht_swit_update {
my ($class, $r, $root) = @_;
my $m = $r->body_status =~ /maximum/;
my $to = $m ? "r?val=too_big" : "r";
return $class->swit_failure($to, 'the_upload') if ($m || $root->val);
$root->cdbi_create_or_update;
return $root->ht_make_query_string("r", "id");
}
1;
t/apache/060_guitest.t view on Meta::CPAN
use warnings FATAL => 'all';
use Test::More tests => 22;
use Apache::SWIT::Test::Utils;
use Encode;
BEGIN { use_ok('T::Test');
use_ok('T::DBPage');
}
T::Test->make_aliases(db_page => 'T::DBPage', upload => 'T::Upload');
is($ENV{SWIT_HAS_APACHE}, 1);
my $t;
eval { $t = T::Test->new_guitest; };
SKIP: {
skip "Unable to load guitest", 18 unless $t;
is($ENV{MOZ_NO_REMOTE}, 1); # or else there are coredumps sometimes
$t->ok_ht_db_page_r(base_url => '/test/db_page/r', ht => {
t/apache/060_guitest.t view on Meta::CPAN
$t->ok_ht_db_page_r(base_url => '/test/db_page/r', ht => {
val => ''
});
$t->ht_db_page_u(ht => { val => 'hoho' });
$t->ok_ht_db_page_r(ht => { val => 'hoho', HT_SEALED_id => 1 });
ASTU_Reset_Table("dbp");
$t->ok_ht_upload_r(base_url => '/test/upload/r', ht => { the_upload => ''
, HT_SEALED_loid => '' });
my @res = $t->ht_upload_u(ht => { the_upload => '/etc/passwd' }
, button => [ 0 ]);
my ($enc_loid) = ($res[0] =~ /loid=(\w+)/);
isnt($enc_loid, undef) or exit 1;
my $loid = HTML::Tested::Seal->instance->decrypt($enc_loid);
cmp_ok($loid, '>', 0) or exit 1;
my $uri = $t->mech->uri;
$t->ok_follow_link(text => 'Get Plain');
$t->with_or_without_mech_do(2, sub {
t/apache/080_upload.t view on Meta::CPAN
use Test::More tests => 20;
use Data::Dumper;
use File::Temp qw(tempdir);
use File::Slurp;
BEGIN { use_ok('T::Test');
use_ok('T::Upload');
use_ok('T::Empty');
};
T::Test->make_aliases(upload => 'T::Upload', empty => 'T::Empty');
my $td = tempdir('/tmp/lo_test_XXXXXXXX', CLEANUP => 1);
my $t = T::Test->new;
$t->ok_ht_upload_r(base_url => '/test/upload/r', ht => { the_upload => ''
, HT_SEALED_loid => '' });
my @res = $t->ht_upload_u(ht => { the_upload => '/etc/passwd' });
my ($enc_loid) = ($res[0] =~ /loid=(\w+)/);
isnt($enc_loid, undef) or exit 1;
my $loid = HTML::Tested::Seal->instance->decrypt($enc_loid);
cmp_ok($loid, '>', 0) or exit 1;
my $dbh = Apache::SWIT::DB::Connection->instance->db_handle;
$dbh->begin_work;
$dbh->func($loid, "$td/passwd", 'lo_export')
or die "# Unable to export $loid!";
$dbh->commit;
is(read_file("$td/passwd"), read_file('/etc/passwd'));
$t->ok_follow_link(text => 'Get Plain');
$t->with_or_without_mech_do(2, sub {
is($t->mech->content, read_file('/etc/passwd'));
is($t->mech->ct, 'text/plain');
});
$t->ok_ht_upload_r(base_url => '/test/upload/r', ht => { the_upload => ''
, HT_SEALED_loid => '' });
$t->ht_upload_u(ht => { mime_upload => '/etc/passwd' });
$t->ok_follow_link(text => 'Get Mime');
is($t->mech->content, read_file('/etc/passwd'));
is($t->mech->ct, 'text/plain');
$t->ok_ht_empty_r(base_url => '/test/empty/r', ht => { first => '' });
$t->ht_empty_u(ht => {});
$t->ok_ht_empty_r(ht => { first => '' });
$t->ok_ht_upload_r(base_url => '/test/upload/r', ht => { the_upload => ''
, HT_SEALED_loid => '' });
$t->ht_upload_u(ht => { the_upload => '/etc/passwd', val => 'failv' });
$t->ok_ht_upload_r(ht => { the_upload => '', val => 'failv'
, HT_SEALED_loid => '' });
$t->ok_ht_upload_r(base_url => '/test/upload/r', ht => { the_upload => '' });
$t->ht_upload_u(ht => { the_upload => '/bin/ls' });
$t->ok_ht_upload_r(ht => { the_upload => '', val => 'too_big'
, HT_SEALED_loid => '' });
t/conf/extra.conf.part view on Meta::CPAN
<Location /test/db_page/u>
SetHandler perl-script
PerlHandler T::DBPage->swit_update_handler
</Location>
<Location /test/cthan>
SetHandler perl-script
PerlHandler T::SWIT->ct_handler
</Location>
<Location /test/upload/r>
SetHandler perl-script
PerlSetVar SWITTemplate templates/upload.tt
PerlHandler T::Upload->swit_render_handler
</Location>
<Location /test/upload/u>
SetHandler perl-script
PerlHandler T::Upload->swit_update_handler
</Location>
<Location /test/empty/r>
SetHandler perl-script
PerlSetVar SWITTemplate templates/empty_up.tt
PerlHandler T::Empty->swit_render_handler
</Location>
t/templates/htpage.tt view on Meta::CPAN
<html>
<body>
[% INCLUDE templates/more.tt %]
<form action="u" method="post" enctype="multipart/form-data">
:[% template.name %]:
hello [% hello %]
file: [% file %]
upload: [% up %]
[% hid %]
host: [% hostport %]
[% inhe_val%]
<input type="submit" />
<!-- Test.pm should handle readonly fields with no name -->
<input type="hidden" />
</form>
<form name="aa" method="post">
[% inv_up %]
<input type="submit" />
t/templates/upload.tt view on Meta::CPAN
<html>
<body>
<a href="../download/r?loid=[% loid %]&ct=text/plain">Get Plain</a>
<a href="../download/r?loid=[% loid %]">Get Mime</a>
[% form %]
[% the_upload %]
[% mime_upload %]
[% val %]
<input type="submit" />
</form>
</body>
</html>
( run in 2.237 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )