view release on metacpan or  search on metacpan

t/unit/intermediate_file.t  view on Meta::CPAN

{
	my $permanent_name = "$rootdir/permanent_file1";
	my $I = App::MtAws::IntermediateFile->new(target_file => $permanent_name);
	my $filename = $I->tempfilename;
	ok -f $filename, "should create temp file";
	ok -e $filename, "file exists";

	ok open(my $f, ">", $filename), "open should work";
	my $data_sample = "abcdefxyz\n";
	print $f $data_sample;
	ok close($f), "close should work";

	ok ! -e $permanent_name, "assume permanent file not yet exists";
	$I->make_permanent;

	is ( (stat($permanent_name)->mode & 07777), (0666 & ~umask), "file should have default permissions");
	is slurp($permanent_name), $data_sample, "data should be readable";
}

{
	my $permanent_name = "$rootdir/permanent_file2";
	my $I = App::MtAws::IntermediateFile->new(target_file => $permanent_name, mtime => 1234567);
	my $filename = $I->tempfilename;
	ok -f $filename, "should create temp file";
	ok -e $filename, "file exists";
	ok ! -e $permanent_name, "assume permanent file not yet exists";
	$I->make_permanent;

	is stat($permanent_name)->mtime, 1234567, "it should set mtime";
}

{
	my $permanent_name = "$rootdir/permanent_file4";
	my $I = App::MtAws::IntermediateFile->new(target_file => $permanent_name, mtime => undef);
	my $filename = $I->tempfilename;
	ok -f $filename, "should create temp file";
	ok -e $filename, "file exists";
	ok ! -e $permanent_name, "assume permanent file not yet exists";
	my $saved_mtime = stat($filename)->mtime;
	$I->make_permanent;

	is stat($permanent_name)->mtime, $saved_mtime, "it should work with mtime=undef";
}

{
	my $permanent_name = "$rootdir/permanent_file3";
	my $I = App::MtAws::IntermediateFile->new(target_file => $permanent_name);
	my $filename = $I->tempfilename;
	ok -f $filename, "should create temp file";

	ok ! -e $permanent_name, "assume permanent file not yet exists";
	$I->make_permanent;
	ok ! defined eval { $I->make_permanent; 1; }, "should confess if make_permanent called twice";
	like $@, qr/file already permanent or not initialized/, "should confess with right message if make_permanent called twice";

}

{
	ok ! -e do {
		my $I = App::MtAws::IntermediateFile->new(target_file => "$rootdir/something_not_existant");
		my $filename = $I->tempfilename;
		ok -f $filename, "should create temp file";
		$filename;
	}, "file auto-removed";
}

for (['a'], ['b','c'], ['b', 'c', 'd'], ['e', 'f', 'g']) {
	my $subdir = join('/', @$_);
	my $fulldir = "$rootdir/$subdir";
	my $perm_file = "$fulldir/permfile";
	my $I = App::MtAws::IntermediateFile->new(target_file => $perm_file);
	my $filename = $I->tempfilename;
	ok -f $filename, "should create temp file and several subdirs: $subdir";
	ok -d $fulldir, "just checking that directory is directory";

	my $trydir = '';
	for my $part (@$_) {
		$trydir .= '/' . $part;
		is ( (stat("$rootdir$trydir")->mode & 07777), (0777 & ~umask), "directory $trydir should have default permissions");
	}
	is $trydir, "/$subdir", "assume tested directories calculated correctly";
}

{
	ok -f do {
		my $permanent_name = "$rootdir/permanent_file";
		my $I = App::MtAws::IntermediateFile->new(target_file => $permanent_name);
		my $filename = $I->tempfilename;
		ok -f $filename, "should create temp file";
		ok ! -e $permanent_name, "assume permanent file not yet exists";
		$I->make_permanent;
		ok ! -e $filename, "temp file is gone";
		ok -f $permanent_name, "file moved to permanent location";
		$permanent_name;
	}, "permanent file not discarded";

}

SKIP: {
	skip "Cannot run under root", 5 if is_posix_root;
	my $dir = "$rootdir/denied1";
	ok mkpath($dir), "path is created";
	ok -d $dir, "path is created";;
	chmod 0444, $dir;
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$dir/somefile"); 1 }, "File::Temp should throw exception";
	is get_exception->{code}, 'cannot_create_tempfile', "File::Temp correct code for exception";
	is get_exception->{dir}, $dir, "File::Temp correct dir for exception";
}

SKIP: {
	skip "Cannot run under root", 5 if is_posix_root;
	my $dir = "$rootdir/denied2";
	ok mkpath($dir), "path is created";
	ok -d $dir, "path is created";;
	chmod 0444, $dir;
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$dir/b/c/somefile"); 1 }, "mkpath() should throw exception";
	is get_exception->{code}, 'cannot_create_directory', "mkpath correct code for exception";
	is get_exception->{dir}, "$dir/b/c", "mkpath correct dir for exception";
}

SKIP: {
	skip "Cannot run under root", 7 if is_posix_root;
	my $dir = "$rootdir/testpermanent";
	ok ! -e $dir, "not yet exists";
	ok mkpath($dir), "path is created";
	ok -d $dir, "path is created";
	my $dest = "$dir/dest";
	mkdir "$dir/dest";
	my $I = App::MtAws::IntermediateFile->new(target_file => $dest);
	my $tmpfile = $I->tempfilename;
	ok ! defined eval { $I->make_permanent; 1 }, "should throw exception if cant rename files";
	is get_exception->{code}, 'cannot_rename_file', "correct exception code";
	is get_exception->{from}, $tmpfile, "correct exception 'from'";
	is get_exception->{to}, $dest, "correct exception 'to'";
}

{
	is get_filename_encoding, 'UTF-8', "assume utf8 encoding is set";
	my $dir = "$rootdir/тест2";
	my $I = App::MtAws::IntermediateFile->new(target_file => "$dir/somefile");
	like $I->tempfilename, qr/\Q$dir\E/, "filename should contain directory name, thus be in UTF8";
	ok -d $dir, "dir in UTF-8 should not exist";
}

SKIP: {
	skip "Test cannot be performed on character-oriented filesystem", 5 unless can_work_with_non_utf8_files;
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R', "assume encoding is set";
	my $dir = "$rootdir/тест1";
	my $koidir = encode("KOI8-R", $dir);
	my $I = App::MtAws::IntermediateFile->new(target_file => "$dir/somefile");
	like $I->tempfilename, qr/\Q$dir\E/, "filename should contain directory name, thus be in UTF8";
	unlike $I->tempfilename, qr/\Q$koidir\E/, "filename should not contain KOI8-R directory name";
	ok ! -d $dir, "dir in UTF-8 should not exist";
	ok -d $koidir, "dir in KOI8-R should exist";
}

SKIP: {
	skip "Test cannot be performed on character-oriented filesystem", 7 unless can_work_with_non_utf8_files;
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R', "assume encoding is set";
	my $dir = "$rootdir/test_permanent_and_encoding";
	my $perm_file = "$rootdir/test_permanent_and_encoding_файл";
	my $koi_perm_file = encode("KOI8-R", $perm_file);
	ok ! -e $dir, "dir does not exist";
	ok ! -e $perm_file, "perm_file in UTF8 does not exist";
	ok ! -e $koi_perm_file, "perm_file in KOI8-R does not exist";
	my $I = App::MtAws::IntermediateFile->new(target_file => $perm_file, mtime => 1234567);
	$I->make_permanent;
	ok ! -e $perm_file, "perm_file in UTF8 does not exist";
	ok -e $koi_perm_file, "perm_file in KOI8-R exists";
	is stat($koi_perm_file)->mtime, 1234567, "it should set mtime";
}

SKIP: {
	for (5) {
		skip "Test cannot be performed on character-oriented filesystem", $_ unless can_work_with_non_utf8_files;
		skip "Cannot run under root", $_ if is_posix_root;
	}
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R', "assume encoding is set";
	my $basedir = "$rootdir/base1";
	ok ! -e $basedir, "basedir not yet exists";
	ok mkpath($basedir), "basedir created";
	chmod 0444, $basedir;
	my $dir = "$basedir/тест1";
	my $koidir = encode("KOI8-R", $dir);
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$dir/somefile"); 1 }, "should fail with exception";
	my $msg = exception_message(get_exception);
	$msg =~ s/[[:ascii:]]//g;
	like $msg, qr/^(тест)+$/, "the only non-ascii characters should be utf name";
}