view release on metacpan or  search on metacpan

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

{
	require App::MtAws::Command::Sync;
	require App::MtAws::Command::Retrieve;
	require App::MtAws::Command::CheckLocalHash;
	require App::MtAws::Command::DownloadInventory;
	require App::MtAws::Command::ListVaults;
}

sub check_all_dynamic_modules
{
	# we load here all dynamically loaded modules, to check that installation is correct.
	load_all_dynamic_modules();
	check_module_versions;
}

sub main
{
	$|=1;
	STDERR->autoflush(1);
	print "MT-AWS-Glacier, Copyright 2012-2014 Victor Efimov http://mt-aws.com/ Version $VERSION$VERSION_MATURITY\n\n";

	warn "**NOT RECOMMENDED FOR PRODUCTION USE UNDER CYGWIN**\n\n" if ($^O eq 'cygwin');
	die "**DEVELOPMENT VERSION, NOT FOR PRODUCTION USE. EXITING**\n\n" if ($VERSION =~ /_/);
	warn "**NOT TESTED UNDER PERLIO=stdio**\n\n" if (defined $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/);
	die "Will *not* work under Win32\n" if ($^O eq 'MSWin32');

	check_module_versions();
	unless (defined eval {process(); 1;}) {
		dump_error(q{});
		exit(1);
	}
	print "OK DONE\n";
	exit(0);
}

sub process
{
	my ($P) = @_;
	my ($src, $vault, $journal);
	my $maxchildren = 4;
	my $config = {};
	my $config_filename;


	my $res = App::MtAws::ConfigDefinition::get_config()->parse_options(@ARGV);
	my ($action, $options) = ($res->{command}, $res->{options});
	if ($res->{warnings}) {
		while (@{$res->{warnings}}) {
			my ($warning, $warning_text) = (shift @{$res->{warnings}}, shift @{$res->{warning_texts}});
			print STDERR "WARNING: $warning_text\n";
		}
	}
	if ($res->{error_texts}) {
		for (@{$res->{error_texts}}) {
			print STDERR "ERROR: ".$_."\n";
		}
		die exception cmd_error => 'Error in command line/config'
	}
	if ($action ne 'help' && $action ne 'version') {
		$PerlIO::encoding::fallback = Encode::FB_QUIET;
		binmode STDERR, ":encoding($options->{'terminal-encoding'})";
		binmode STDOUT, ":encoding($options->{'terminal-encoding'})";
	}

	my %journal_opts = ( journal_encoding => $options->{'journal-encoding'} );

	if ($action eq 'sync') {
		die "Not a directory $options->{dir}" unless -d binaryfilename $options->{dir};

		my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal}, root_dir => $options->{dir},
			filter => $options->{filters}{parsed}, leaf_optimization => $options->{'leaf-optimization'}, follow => $options->{'follow'});

		require App::MtAws::Command::Sync;
		check_module_versions;
		App::MtAws::Command::Sync::run($options, $j);

	} elsif ($action eq 'upload-file') {

		defined(my $relfilename = $options->{relfilename})||confess;
		my $partsize = delete $options->{partsize};

		my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal});

		with_forks 1, $options, sub {

			$j->read_journal(should_exist => 0);

			## no Test::Tabs
			die <<"END"
File with same name already exists in Journal.
In the current version of mtglacier you are disallowed to store multiple versions of same file.
Multiversion will be implemented in the future versions.
END
				if (defined $j->{journal_h}->{$relfilename});
			## use Test::Tabs

			if ($options->{'data-type'} ne 'filename') {
				binmode STDIN;
				check_stdin_not_empty(); # after we fork, but before we touch Journal for write and create Amazon Glacier upload id
			}

			$j->open_for_write();

			my $ft = ($options->{'data-type'} eq 'filename') ?
				App::MtAws::QueueJob::Upload->new(
					filename => $options->{filename}, relfilename => $relfilename,
					partsize => ONE_MB*$partsize, delete_after_upload => 0) :
				App::MtAws::QueueJob::Upload->new(
					stdin => 1, relfilename => $relfilename,
					partsize => ONE_MB*$partsize, delete_after_upload => 0);

			my ($R) = fork_engine->{parent_worker}->process_task($ft, $j);
			die unless $R;
			$j->close_for_write();
		}
	} elsif ($action eq 'purge-vault') {
		my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal}, filter => $options->{filters}{parsed});

		with_forks !$options->{'dry-run'}, $options, sub {
			$j->read_journal(should_exist => 1);

			my $archives = $j->{archive_h};
			if (scalar keys %$archives) {
				if ($options->{'dry-run'}) {
					for (keys %$archives) {
						print "Will DELETE archive $_ (filename $archives->{$_}{relfilename})\n"
					}
				} else {
					$j->open_for_write();

					my @filelist = map { {archive_id => $_, relfilename =>$archives->{$_}->{relfilename} } } keys %{$archives};
					my $ft = App::MtAws::QueueJob::Iterator->new(iterator => sub {
						if (my $rec = shift @filelist) {
							return App::MtAws::QueueJob::Delete->new(
								relfilename => $rec->{relfilename}, archive_id => $rec->{archive_id},
							);
						} else {
							return;
						}
					});
					my ($R) = fork_engine->{parent_worker}->process_task($ft, $j);
					die unless $R;

					$j->close_for_write();
				}
			} else {
				print "Nothing to delete\n";
			}
		}
	} elsif ($action eq 'restore') {
		my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal}, root_dir => $options->{dir}, filter => $options->{filters}{parsed}, use_active_retrievals => 1);
		confess unless $options->{'max-number-of-files'};


		require App::MtAws::Command::Retrieve;
		check_module_versions;
		App::MtAws::Command::Retrieve::run($options, $j);
	} elsif ($action eq 'restore-completed') {