App-MtAws

 view release on metacpan or  search on metacpan

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

# mt-aws-glacier - Amazon Glacier sync client
# Copyright (C) 2012-2014  Victor Efimov
# http://mt-aws.com (also http://vs-dev.com) vs@vs-dev.com
# License: GPLv3
#
# This file is part of "mt-aws-glacier"
#
#    mt-aws-glacier is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    mt-aws-glacier is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

package App::MtAws::Command::Sync;

our $VERSION = '1.120';

use strict;
use warnings;
use utf8;
use Carp;
use constant ONE_MB => 1024*1024;

use constant SHOULD_CREATE => 1;
use constant SHOULD_TREEHASH => 2;
use constant SHOULD_NOACTION => 0;

use App::MtAws::QueueJob::Iterator;
use App::MtAws::QueueJob::VerifyAndUpload;
use App::MtAws::QueueJob::Upload;
use App::MtAws::QueueJob::Delete;

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
{
	my ($options, $journal_file, $absfilename) = @_;

	if ($options->{detect} eq 'always-positive') {
		SHOULD_CREATE;
	} elsif ($journal_file->{size} != file_size($absfilename)) {
		SHOULD_CREATE;
	} elsif ($options->{detect} eq 'size-only') {
		SHOULD_NOACTION; # we already checked size above, so NOACTION
	} elsif ($options->{detect} eq 'mtime') {
		is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_CREATE : SHOULD_NOACTION;
	} elsif ($options->{detect} eq 'treehash') {
		SHOULD_TREEHASH;
	} elsif ($options->{detect} eq 'mtime-and-treehash') {
		is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_TREEHASH : SHOULD_NOACTION;
	} elsif ($options->{detect} eq 'mtime-or-treehash') {
		is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_CREATE : SHOULD_TREEHASH;
	} else {
		confess "Invalid detect option in should_upload";
	}
}

sub next_modified
{
	my ($options, $j) = @_;
	while (my $rec = shift @{ $j->{listing}{existing} }) {
		my $relfilename = $rec->{relfilename};
		my $absfilename = $j->absfilename($relfilename);
		my $file = $j->latest($relfilename);

		my $should_upload = should_upload($options, $file, $absfilename);

		if ($should_upload == SHOULD_TREEHASH) {
			return App::MtAws::QueueJob::VerifyAndUpload->new(
				filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize},
				delete_after_upload => 1,
				archive_id => $file->{archive_id},
				treehash => $file->{treehash}
			);
		} elsif ($should_upload == SHOULD_CREATE) {
			return App::MtAws::QueueJob::Upload->new(
				filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize},
				delete_after_upload => 1,
				archive_id => $file->{archive_id},
			);
		} elsif ($should_upload == SHOULD_NOACTION) {
			next;
		} else {
			confess "Unknown value returned by should_upload";
		}



( run in 1.197 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )