Group
Extension

Apache-SWIT/t/570_run_server.t

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

use Test::More tests => 31;
use Test::TempDatabase;
use Apache::SWIT::Test::Utils;
use File::Slurp;
use LWP::UserAgent;
use IPC::Run qw( start pump finish timeout ) ;

BEGIN { use_ok('Apache::SWIT::Maker');
	use_ok('Apache::SWIT::Test::ModuleTester');
}

Apache::SWIT::Test::ModuleTester::Drop_Root();

my $mt = Apache::SWIT::Test::ModuleTester->new({ root_class => 'TTT' });
my $td = $mt->root_dir;
chdir $td;
$mt->make_swit_project;
ok(-f 'LICENSE');
`perl Makefile.PL && make 2>&1`;

my $psql = `psql -l`;
$ENV{ASTU_MEM} = 1;
my @cmd = ("./scripts/swit_app.pl", "run_server"); 
my ($in, $out, $err);
my $t = timeout(30);

my $h = start(\@cmd, \$in, \$out, \$err, $t);
eval { pump $h until $err =~ /Press Enter to finish \.\.\./; };
if ($@) {
	diag("Error in pumping: $@\n$err");
	exit 1;
}

my ($host) = ($out =~ /server ([^\n]+) started/);
like($err, qr/Press Enter to finish \.\.\./);
like($err, qr/Apache memory before/);
isnt($host, undef) or $host = '';

my $ua = LWP::UserAgent->new;
my $cont = $ua->get("http://$host/ttt/index/r")->content;
like($cont, qr/first/) or ASTU_Wait(read_file('t/logs/error_log'));
like($err, qr#http://$host#);

unlike($out, qr/Leaving/);
$in .= "\n";
pump $h;

while(pump $h) {}
like($out, qr/Leaving/);
like($err, qr/Apache memory after/);
finish $h or die "cmd returned $?" ;

($in, $out, $err) = ();
my $help = `./scripts/swit_app.pl 2>&1`;
like($help, qr/run_server.*host.*port/);

system("make realclean 2>/dev/null 1>/dev/null");
push @cmd, "goo.ga:11111";

delete $ENV{ASTU_MEM};
$h = start(\@cmd, \$in, \$out, \$err, $t);
pump $h until $err =~ /Press Enter to finish \.\.\./;
($host) = ($out =~ /server ([^\n]+) started/);
like($err, qr/Press Enter to finish \.\.\./);
unlike($err, qr/memory before/);
is($host, "goo.ga:11111");
finish $h or die "cmd returned $?" ;
unlike($err, qr/memory after/);

$mt->insert_into_schema_pm('
$dbh->do("create table one_col_table (id serial primary key, ocol text)");
');

push @cmd, "swit_run_server_db";
$h = start(\@cmd, \$in, \$out, \$err, $t);
eval { pump $h until $err =~ /Press Enter to finish \.\.\./; };
is($@, '') or ASTU_Wait($err);
($host) = ($out =~ /server ([^\n]+) started/);
like($err, qr/Press Enter to finish \.\.\./);
is($host, "goo.ga:11111");
like(`psql -l`, qr/swit_run_server_db/);
finish $h or die "cmd returned $?" ;

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

`psql -c "insert into one_col_table (ocol) values ('gggg')" swit_run_server_db`;
is($?, 0);

`./scripts/swit_app.pl scaffold one_col_table 2>&1`;
is($?, 0);
ok(-f 'lib/TTT/DB/OneColTable.pm');

$cmd[2] = 1;
$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/);

END {
`dropdb swit_run_server_db 2>&1 1>/dev/null`;
is(`psql -l`, $psql);
};

chdir '/';



Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.