App-MtAws

 view release on metacpan or  search on metacpan

lib/App/MtAws/Command/Sync.pm  view on Meta::CPAN

use App::MtAws::ForkEngine  qw/with_forks fork_engine/;
use App::MtAws::Journal;
use App::MtAws::Utils;



sub is_mtime_differs
{
	my ($options, $journal_file, $absfilename) = @_;
	my $mtime_differs = $options->{detect} =~ /(^|[-_])mtime([-_]|$)/ ? # don't make stat() call if we don't need it
		defined($journal_file->{mtime}) && file_mtime($absfilename) != $journal_file->{mtime} :
		undef;
}

# implements a '--detect' logic for file (with check of file size and mtime)
# returns:
#  SHOULD_CREATE - upload file
#  SHOULD_TREEHASH - upload a file if treehash differs
#  SHOULD_NOACTION - don't do anything
sub should_upload

lib/App/MtAws/Utils.pm  view on Meta::CPAN

}

sub file_mtime($%)
{
	my $filename = shift;
	my (%args) = (use_filename_encoding => 1, @_);
	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}
	confess "file not exists" unless -f $filename;
	return stat($filename)->mtime;
}

# TODO: test
sub file_inodev($%)
{
	my $filename = shift;
	my (%args) = (use_filename_encoding => 1, @_);
	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}
	confess "file not exists" unless -e $filename;
	my $s = stat($filename);
	$s->dev."-".$s->ino;
}

sub is_wide_string
{
	defined($_[0]) && utf8::is_utf8($_[0]) && (bytes::length($_[0]) != length($_[0]))
}

# if we have ASCII-only data, let's drop UTF-8 flag in order to optimize some regexp stuff
# TODO: write also version which does not check is_utf8 - it's faster when utf8 always set

t/integration/child_worker.t  view on Meta::CPAN

		App::MtAws::GlacierRequest->expects('perform_lwp')->any_number->returns(sub {
			my ($self) = @_;
			$self->{writer}->reinit($data_size);
			$self->{writer}->add_data($data_blob);
			$self->{writer}->finish();
			return $response;
		});
		$C->process_task('retrieval_download_job', { jobid => 'myjobid', relfilename => 'targed_file.txt', mtime => 1234567,
			filename => $data_filename, size => $data_size, treehash => $data_treehash}, undef);

		is ( (stat($data_filename)->mode & 07777), (0666 & ~umask), "file should have default permissions");
		is stat($data_filename)->mtime, 1234567, "should set mtime";
		open(my $f, "<", $data_filename) or confess;
		my $got_data = do { local $/; <$f> };
		close $f;
		is $got_data, $data_blob;
	};
};


sub treehash_fast
{

t/integration/config_engine_upload_file_real.t  view on Meta::CPAN

	with_my_dir "restricted/normal", "restricted/normal/another", sub {
		touch $file_abs;

		mkpath "top";

		my $file_rel = "file";
		my $normal_rel = "../normal";

		is stat($file_rel)->ino, stat($file_abs)->ino;
		is stat($normal_rel)->ino, stat($normal_abs)->ino;

		ok -f $file_rel;
		ok -f $file_abs;
		ok -d $normal_rel;
		ok -d $normal_rel;


		test_file_and_dir "dir/filename should work",
			"another/..", $file_rel, $file_rel;

t/integration/queue_job/multipart_create_files.t  view on Meta::CPAN

	cmp_deeply $err, superhashof { code => 'file_is_zero',
		message => "File size is zero (and it was not when we read directory listing). Filename: %string filename%",
		filename => $filename };
	unlink $filename;
}

{
	create($filename, 'abc');
	my $job = App::MtAws::QueueJob::MultipartCreate->new(filename => $filename, relfilename => $relfilename, partsize => 2);
	$job->init_file();
	is $job->{mtime}, stat($filename)->mtime;
	unlink $filename;
}

SKIP: {
	skip "Test cannot be performed on character-oriented filesystem", 3 unless can_work_with_non_utf8_files;

	my $filename = "тест42";
	my $fullfilename = "$mtroot/$filename";
	my $koi_filename = encode("KOI8-R", $fullfilename);
	create($koi_filename, 'abc');
	ok !-e $fullfilename;
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R', "assume encoding is set";
	my $job = App::MtAws::QueueJob::MultipartCreate->new(filename => $fullfilename, relfilename => $relfilename, partsize => 2);
	$job->init_file();
	is $job->{mtime}, stat($koi_filename)->mtime;
	unlink $koi_filename;
}

SKIP: {
	skip "Cannot run under root", 3 if is_posix_root;

	create($filename, 'x');
	chmod 0000, $filename;
	my $job = App::MtAws::QueueJob::MultipartCreate->new(filename => $filename, relfilename => $relfilename, partsize => 2);
	ok ! eval { $job->init_file(); 1; };

t/lib/JournalTest.pm  view on Meta::CPAN

sub check_absfilename
{
	my ($self, $should_exist, $relfilename, $absfilename) = @_;

	my $absfilename_old = $self->characterpath(File::Spec->rel2abs($self->binarypath($relfilename), $self->binarypath($self->{dataroot})));
	my $absfilename_correct = File::Spec->catfile($self->{dataroot}, $relfilename);
	my $absfilename_wrong = $self->characterpath(File::Spec->abs2rel(File::Spec->rel2abs($self->binarypath($relfilename), $self->binarypath($self->{dataroot}))));

	if ($should_exist) {
		my $ino_old = stat($self->binarypath($absfilename_old))->ino;
		ok $ino_old;
		is stat($self->binarypath($absfilename_correct))->ino, $ino_old;
		is stat($self->binarypath($absfilename_wrong))->ino, $ino_old;
	}

	#TODO: add File::Spec->canonpath() to _correct and fix absfilename_correct=./dirA/file3
	ok $absfilename_old =~ m{^/};

	ok $absfilename !~ m{//};

	ok $absfilename =~ m{^\Q$self->{dataroot}/\E} unless $self->{dataroot} =~ m{^\.(/|$)};
	is ($absfilename, $absfilename_correct, "absfilename match");
}

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

	my $I = bless {}, 'App::MtAws::IntermediateFile';
	ok ! defined eval { $I->make_permanent(1); 1 }, "should confess if extra args provided";
	like $@, qr/unknown arguments/, "should confess with right message";
}

{
	my $I = App::MtAws::IntermediateFile->new(target_file => "$rootdir/target1");
	my $filename = $I->tempfilename;
	ok -f $filename, "should create temp file";
	ok -e $filename, "file exists";
	my $perms = stat($filename)->mode & 07777;
	is $perms & 0077, 0, "file should not be world accessible";
	ok $perms & 0400, "file should be readable";
	ok $perms & 0200, "file should be writable";
	ok $filename =~ /__mtglacier_temp/, 'file should have __mtglacier_temp in name';
	ok $filename =~ /\.tmp$/, 'file should end with .tmp extension';
	ok $filename =~ /$$/, 'file should contain PID';
	ok $filename =~ /^\Q$rootdir\E\/__mtglacier_temp/, "file should be inside supplied directory";
	ok open(my $f, ">", $filename), "open should work";
	my $data_sample = "abcdef\n";
	print $f $data_sample;

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

	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;

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

	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";

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

	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";