Apache-SWIT
view release on metacpan or search on metacpan
lib/Apache/SWIT/Test/DB.pm
t/100_session.t
t/050_file_writer.t
t/045_conversions.t
t/200_db_connection.t
t/400_skeleton.t
t/450_makefile.t
t/500_swit_init.t
t/505_dual.t
t/510_install.t
t/515_backup.t
t/520_db.t
t/525_sub_install.t
t/530_subsystem.t
t/565_migration.t
t/545_session.t
t/540_db_class.t
t/555_move.t
t/550_scaffold.t
t/560_ht_seal.t
t/570_run_server.t
lib/Apache/SWIT/Maker.pm view on Meta::CPAN
}
sub do_swit_app_cmd {
my ($self, $cmd, @args) = @_;
my $p = $self->swit_app_cmd_params($cmd) or return;
my ($mf_before);
local $ExtUtils::Manifest::Quiet = 1;
my $bf_name = join("_", $cmd, @args);
$bf_name =~ s/\W/_/g;
my $cwd = getcwd();
my $backup_dir = "$cwd/../$bf_name";
if ($p->[1]) {
$mf_before = maniread();
manicopy($mf_before, $backup_dir);
conv_silent_system("make realclean") if -f 'Makefile';
}
eval { $self->$cmd(@args); };
my $err = $@;
if ($err && $p->[1]) {
chdir $backup_dir;
manicopy($mf_before, $cwd);
chdir $cwd;
} elsif ($p->[1]) {
mkpath("backups");
my $mf = maniread();
$mf->{$_} = 1 for keys %$mf_before;
# diff returns 1 for some reason
system("diff -uN $backup_dir/$_ $_ >> backups/$bf_name.patch")
for (sort keys %$mf);
conv_silent_system("perl Makefile.PL");
}
rmtree($backup_dir) if $p->[1];
die "Rolled back. Original exception is $err" if $err;
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);
t/515_backup.t view on Meta::CPAN
chdir $mt->root_dir;
$mt->make_swit_project;
ok(-f 'LICENSE');
ok(-f 'lib/TTT/DB/Schema.pm');
my $md5 = dist_md5();
my $res = `./scripts/swit_app.pl add_ht_page TTT::SomePage`;
is($?, 0) or ASTU_Wait();
unlike($res, qr/mkdir/);
ok(-f 'lib/TTT/SomePage.pm');
ok(-f 'backups/add_ht_page_TTT__SomePage.patch');
$res = `make dist`;
is($?, 0);
like($res, qr/SomePage/);
ok(-f "TTT-0.01.tar.gz") or ASTU_Wait($mt->root_dir);
$res = `patch -p0 -R < backups/add_ht_page_TTT__SomePage.patch`;
like($res, qr/SomePage/);
ok(! -f 'lib/TTT/SomePage.pm');
is(dist_md5(), $md5);
ok(-f 'lib/TTT/UI/Index.pm');
$res = `./scripts/swit_app.pl mv lib/TTT/UI/Index.pm lib/TTT/UI/First.pm 2>&1`;
is($?, 0) or diag($res);
ok(! -f 'lib/TTT/UI/Index.pm');
ok(-f 'lib/TTT/UI/First.pm');
my $pfile = 'backups/mv_lib_TTT_UI_Index_pm_lib_TTT_UI_First_pm.patch';
ok(-f $pfile);
$res = `patch -p0 -R < $pfile`;
like($res, qr/Index/);
ok(-f 'lib/TTT/UI/Index.pm');
ok(! -f 'lib/TTT/UI/First.pm');
is(dist_md5(), $md5);
$mt->insert_into_schema_pm('$dbh->do("create table the_table (
id serial primary key, col1 text, col2 integer)");');
t/540_db_class.t view on Meta::CPAN
ENDT
$res = `make test_ TEST_FILES=t/234_the_table.t 2>&1`;
unlike($res, qr/Failed/);
like($res, qr/success/);
isnt(-f 't/conf/schema.sql', undef);
`make realclean && perl Makefile.PL`;
is(-f 't/conf/schema.sql', undef);
my @lines = `make distcheck 2>&1 | grep MANIFEST`;
is(@lines, 2) or diag(join("", @lines)); # backups, test are 2 lines only
chdir '/'
( run in 0.848 second using v1.01-cache-2.11-cpan-49f99fa48dc )