Apache-SWIT

 view release on metacpan or  search on metacpan

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

		"create table test_table (a integer, b text)");
is_deeply([ T::DBI->retrieve_all ], []);

ENDM
}

sub write_swit_app_pl {
	my $self = shift;
	$self->file_writer->write_scripts_swit_app_pl({
				class => ref($self) });
	chmod 0755, 'scripts/swit_app.pl';
}

sub install {
	my ($self, $inst_dir) = @_;
	my $si = Apache::SWIT::Maker::Config->instance->{skip_install} || [];
	my %skips = map {
		my $v = read_file($_) or die "Nothing for $_";
		($_, $v);
	} map { "blib/$_" } @$si;
	unlink($_) for keys %skips;

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

	$self->write_makefile_pl;
	$self->write_010_db_t;
	$self->write_swit_app_pl;
	$self->add_ht_page('Index');
}

sub dump_db {
	push @INC, "t", "lib";
	unlink("t/conf/schema.sql");
	system("touch t/conf/schema.sql && chmod a+rw t/conf/schema.sql")
		unless ($<);
	conv_eval_use('T::TempDB');
	system("pg_dump -c $ENV{APACHE_SWIT_DB_NAME} > t/conf/schema.sql");
}

sub _make_page {
	my ($self, $page_class, $args, @funcs) = @_;
	my $i = Apache::SWIT::Maker::Config->instance;
	my $e = $i->create_new_page($page_class);
	for my $f (@funcs) {

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

	return 1;
}

sub test_root {
	my ($self, @args) = @_;
	my $td = tempdir("/tmp/swit_test_root_XXXXXX");
	my $cwd = abs_path(getcwd());
	my $mfiles = maniread();
	manicopy($mfiles, $td);
	chdir $td;
	system("chmod a+rwx `find . -type d`") and die;
	system("chmod a+rw `find . -type f`") and die;
	eval "use Test::TempDatabase";

	my $dn = __FILE__;
	for (; basename($dn) ne 'Apache'; $dn = dirname($dn))
		{} # nothing
	system("cp -a $dn .") and die;

	my $pid = fork();
	if (!$pid) {
		Test::TempDatabase->become_postgres_user;

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

	my $class = lc(shift);
	$class =~ s/::/_/g;
	return $class;
}

sub conv_forced_write_file {
	my ($to_conf, $str) = @_;

	# ExtUtils::Install changes permissions to readonly
	my $readonly = ! -w $to_conf;
	chmod 0644, $to_conf if $readonly;
	write_file($to_conf, $str);
	chmod 0444, $to_conf if $readonly;
}

sub conv_eval_use {
	my $c = shift;
	eval "use $c";
	confess "Cannot use $c: $@" if $@;
	return $c;
}

sub conv_file_to_class {

scripts/test_root.pl  view on Meta::CPAN

unshare_ns() and die;

my @mf = read_file('MANIFEST');
my $td = tempdir('/tmp/swit_root_XXXXXX', CLEANUP => 1);
for my $f (@mf) {
	chomp $f;
	mkpath $td . "/" . dirname($f);
	system("cp -a $f $td/$f") and die $f;
}
chdir $td;
system("chmod -R o-rwx *") and die;
system("mount --bind /tmp /usr/local/share/perl/5.10.0/Apache") and die;
system("perl Makefile.PL") or system("make") or system("make", @ARGV);
chdir '/';

t/045_conversions.t  view on Meta::CPAN

is(conv_next_dual_test("a/b.pm\nt/323_one.t\nt/dual/110_two.t\n"
			. "t/dual/222_e.t"), "232");
is(conv_next_dual_test("a/b.pm\nt/323_one.t\nt/dual/110_two.t\n"
			. "t/dual/222_e.t\n"), "232");
is(conv_next_dual_test("t/dual/001_load.t"), "011");

is(conv_class_to_app_name("Hello::World"), "hello_world");

my $td = tempdir('/tmp/pltemp_045_XXXXXX', CLEANUP => 1);
write_file("$td/aaa.txt", "ffff\n");
chmod 0444, "$td/aaa.txt";
conv_forced_write_file("$td/aaa.txt", "gggg\n");
is(read_file("$td/aaa.txt"), "gggg\n");
ok(! -w "$td/aaa.txt");

chdir $td;
swmani_write_file("boo/ggg.txt", "hoho");
like(read_file('MANIFEST'), qr/ggg/);
ok(-f "boo/ggg.txt");
swmani_write_file("boo/ccc.txt", "hoho");

t/505_dual.t  view on Meta::CPAN

my $res = `./scripts/swit_app.pl add_class SC`;
is($?, 0);
$mt->replace_in_file("lib/TTT/SC.pm", "1;", <<ENDS);
use File::Slurp;
sub swit_startup {
	append_file("$td/startup_classes_test", \$_[0]);
}
1;
ENDS

system("touch $td/startup_classes_test && chmod a+rw $td/startup_classes_test");
system("chmod a+rxw $td");
my $tree = YAML::LoadFile('conf/swit.yaml');
isnt($tree, undef);
$tree->{startup_classes} = [ 'TTT::SC' ];

$tree->{pages}->{"aga.html"} = { class => 'TTT::UI::Red'
			, handler => 'swit_render_handler' };
YAML::DumpFile('conf/swit.yaml', $tree);

$res = `perl Makefile.PL && APACHE_SWIT_PROFILE=1 make test_dual 2>&1`;
like($res, qr/030_load/);

t/530_subsystem.t  view on Meta::CPAN

`perl Makefile.PL && make 2>&1`;
like(read_file('t/T/Test.pm'), qr/\bthesub\/index/);
$mt->replace_in_file('t/dual/001_load.t', '=> 11', '=> 12');
symlink("$td/TTT/blib/lib/TTT", "blib/lib/TTT") or die "# Unable to symlink";
append_file('t/dual/001_load.t', <<ENDT);
\$t->ok_ht_thesub_index_r(make_url => 1, ht => { first => '' });
ENDT
$ENV{PERL5LIB} = "$idir\:$dn";
if (!$<) {
	for (my $d = $idir; $d ne '/tmp'; $d = dirname($d)) {
		system("chmod a+rx $d") and die;
	}
}
$res = join('', `echo \$PERL5LIB && make test 2>&1`);
unlike($res, qr/Error/) or ASTU_Wait($td);
like($res, qr/thesub\/001/);

chdir "$td/TTT";
$mt->insert_into_schema_pm('\$dbh->do("create table ttt_table (a text)")');
$mt->replace_in_file('lib/TTT/UI/Index.pm', "return \\\$", <<ENDM);
my \$arr = Apache::SWIT::DB::Connection->instance->db_handle

t/570_run_server.t  view on Meta::CPAN

$h = start(\@cmd, \$in, \$out, \$err, $t);
eval { pump $h until $err =~ /Press Enter to finish \.\.\./; };
is($@, '') or ASTU_Wait("$out,\n$err");
($host) = ($out =~ /server ([^\n]+) started/);
like($err, qr/Press Enter to finish \.\.\./);
like($ua->get("http://$host/ttt/onecoltable/list/r")->content, qr/gggg/)
	or ASTU_Wait($td);

my $f = "blib/templates/onecoltable/list.tt";
ok(-f $f);
`chmod +w $f`;
append_file($f, "hhhhh");
sleep 1;
$ua = LWP::UserAgent->new;
like($ua->get("http://$host/ttt/onecoltable/list/r")->content, qr/hhhhh/)
	or diag(read_file($f));

finish $h or die "cmd returned $?" ;

like(`psql -l`, qr/swit_run_server_db/);

t/apache_test.pl  view on Meta::CPAN

my $test_db;
unlink("/tmp/swit_startup_test");
my $d = abs_path(dirname($0));
my $td;
unless ($<) {
	$td = tempdir("/tmp/swit_root_test_XXXXXX");
	print STDERR "# Running as root in $td\n";
	system("cp -a $d/../ $td/") and die;
	chdir $td;
	system("chmod a+rwx `find . -type d`") and die;
	system("chmod a+rw `find . -type f`") and die;
	$d = "$td/t";
	my $pid = fork();
	if ($pid) {
		waitpid $pid, 0;
		chdir '/';
		rmtree $td;
		exit;
	}
	Test::TempDatabase->become_postgres_user;
}