view release on metacpan or  search on metacpan

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

		if (first { present } @l) {
			my $F = App::MtAws::Filter->new();
			for (lists @l) {
				if ($_->{name} eq 'filter') {
					$F->parse_filters($_->{value});
					return error $filter_error, a => $F->{error} if defined $F->{error};
				} elsif ($_->{name} eq 'include') {
					$F->parse_include($_->{value});
				} elsif ($_->{name} eq 'exclude') {
					$F->parse_exclude($_->{value});
				} else {
					confess;
				}
			}
			@l, custom('parsed', $F);
		} else {
			@l;
		}
	}
}

sub check_base_dir
{
	if ( present('base-dir') && !present('dir') ) {
		error('base-dir can be used only with dir');
	} elsif ( present('dir') ) {
		optional('base-dir');
	} else {
		return;
	}
}

#sub abs_dir()
#{
#	custom 'abs-dir', File::Spec->rel2abs(value('dir'));
#}

sub mandatory_maxsize
{
	unless (present(optional('check-max-file-size'))) {
		error('mandatory_with', a => 'check-max-file-size', b => seen('stdin'));
	}
	'check-max-file-size'
}

sub check_dir_or_relname
{

	message 'mutual', "%option a% and %option b% are mutual exclusive";
	message 'mandatory_with', "Need to use %option b% together with %option a%";
	if (present('filename')) {
		custom('data-type', 'filename'), mandatory('filename'), do {
			if (present('set-rel-filename')) {
				if (present('dir')) {
					error('mutual', a => seen('set-rel-filename'), b => seen('dir'));
				} else {
					custom('name-type', 'rel-filename'), mandatory('set-rel-filename'), custom('relfilename', value('set-rel-filename'));
				}
			} elsif (present('dir')) {
				custom('relfilename', do {
					validate 'dir', 'filename';
					if (valid('dir') && valid('filename')) {

						my $b_dir = binary_abs_path(binaryfilename value('dir'));
						my $b_file = binary_abs_path(binaryfilename value('filename'));

						if (!defined $b_dir) {
							error(message('cannot_resolve_dir',
								'Directory specified with "%option a%" cannot be resolved to full path'),
								a => 'dir'), undef
						} elsif (!defined $b_file) {
							error(message('cannot_resolve_file',
								'File specified with "%option a%" cannot be resolved to full path'),
								a => 'filename'), undef;
						} else {
							my $relfilename = characterfilename abs2rel($b_file, $b_dir, allow_rel_base => 0, use_filename_encoding => 0);

							my $dir = value('dir');
							$dir =~ s!/$!!; # just in case

							confess "something wrong with relative-absolute paths"
								unless file_inodev(value('filename')) eq file_inodev($dir."/".$relfilename);

							if (!is_relative_filename($relfilename)) {
								error(message('filename_inside_dir',
									'File specified with %option a% should be inside directory specified in %option b%'),
									a => 'filename', b => 'dir'),
								undef;
							} else {
								$relfilename
							}
						}
					} else {
						undef;
					}
				}), custom('name-type', 'dir'), mandatory('dir');
			} else {
				error(message('either', 'Please specify %option a% or %option b%'), a => 'set-rel-filename', b => 'dir');
			}
		}
	} elsif (present('stdin')) {
		if (present('set-rel-filename')) {
			if (present('dir')) {
				seen('stdin'), mandatory_maxsize, error('mutual', a => seen('set-rel-filename'), b => seen('dir'));
			} else {
				custom('name-type', 'rel-filename'), custom('data-type', 'stdin'), mandatory('set-rel-filename'), mandatory('stdin'),
				custom('relfilename', value('set-rel-filename')), mandatory_maxsize;
			}
		} else {
			error('mandatory_with', a => 'set-rel-filename', b => seen('stdin'))
		}
	} else {
		error(message 'Please specify filename or stdin')
	}
}

sub http_download_options
{
	scope('file_downloads', optional('segment-size'))
}

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

		my $must_be_an_integer = message('must_be_an_integer', '%option a% must be positive integer number');

		option('new', type=>'');
		option('replace-modified', type=>'');
		option('delete-removed', type=>'');


		# treehash, mtime, mtime-and-treehash, mtime-or-treehash
		# mtime-and-treehash := treat_as_modified if differs(mtime) && differs(treehash)
		# mtime-or-treehash := treat_as_modified if differs(mtime) or differs(treehash)
		validation
			option('detect', default => 'mtime-and-treehash'),
			$invalid_format,
			sub { my $v = $_; first { $_ eq $v } qw/treehash mtime mtime-and-treehash mtime-or-treehash always-positive size-only/ };

		my @config_opts = (
			validation(option('key'), $invalid_format, sub { /^[A-Za-z0-9]{20}$/ }),
			validation(option('secret'), $invalid_format, sub { /^[\x21-\x7e]{40}$/ }),
			validation(option('region'), $invalid_format, sub { /^[A-Za-z0-9\-]{3,20}$/ }),
			optional(validation(option('token'), $invalid_format, sub { /^[\x21-\x7e]{20,1024}$/ })),
			validation(option('timeout', default => 180), $invalid_format, sub { /^[0-9]{1,5}$/ }),
			validation(option('protocol', default => 'http'), message('protocol must be "https" or "http"'), sub { /^https?$/ }),
		);

		for (option('concurrency', type => 'i', default => 4)) {
			validation $_, $must_be_an_integer, stop => 1, sub { $_ =~ /^\d+$/ };
			validation $_, message('Max concurrency is 30,  Min is 1'), sub { $_ >= 1 && $_ <= 30 };
		}

		for (option('check-max-file-size', type => 'i')) {
			validation $_, $must_be_an_integer, stop => 1, sub { $_ =~ /^\d+$/ };
			validation $_, message('check-max-file-size should be greater than 0'), stop => 1, sub { $_ > 0 }; # TODO: %option .. %
			validation $_, message('maxsize_too_big', '%option a% should be less than or equal to 40960000 (and you have %value%)'),
				stop => 1, sub { $_ <= 10_000 * 4096 };
		}

		for (option('partsize', type => 'i', default => 16)) {
			validation $_, $must_be_an_integer, stop => 1, sub { $_ =~ /^\d+$/ };
			validation $_, message('Part size must be power of two'), sub { ($_ != 0) && (($_ & ($_ - 1)) == 0) };
			validation $_, message('%option a% must be less or equal to 4096'), sub { $_ <= 4096 };
		}
		for (option('segment-size', type => 'i')) {
			validation $_, $must_be_an_integer, stop => 1, sub { $_ =~ /^\d+$/ };
			validation $_, message('%option a% must be zero or power of two'), sub { (($_ & ($_ - 1)) == 0) }; # TODO: proper format
		}

		validation(option('request-inventory-format', default => 'json'),
			message('request-inventory-format must be "json" or "csv"'), sub { /^(json|csv)$/ });

		validation positional('vault-name'), message('Vault name should be 255 characters or less and consisting of a-z, A-Z, 0-9, ".", "-", and "_"'), sub {
			/^[A-Za-z0-9\.\-_]{1,255}$/
		};

		{
			my $fh = 'for-humans';
			my $mt = 'mtmsg';
			validation(option('format', default => $fh),
				message(qq{%option a% must be "$fh" or "$mt"}), sub { /^(\Q$fh\E|\Q$mt\E)$/ });
		}

		command 'create-vault' => sub { validate(optional('config'), mandatory(@encodings), mandatory('vault-name'), mandatory(@config_opts), check_https)};
		command 'delete-vault' => sub { validate(optional('config'), mandatory(@encodings), mandatory('vault-name'), mandatory(@config_opts), check_https)};
		command 'list-vaults' => sub {
			validate(optional('config'), mandatory(@encodings), optional('dry-run'), mandatory(@config_opts), check_https, mandatory('format'))
		};

		command 'sync' => sub {
			validate(mandatory(
				optional('config'), mandatory(@encodings), @config_opts, sync_opts, detect_opts, check_https,
				qw/dir vault concurrency partsize/, writable_journal('journal'),
				optional(qw/max-number-of-files leaf-optimization follow/),
				filter_options, optional('dry-run')
			))
		};

		command 'upload-file' => sub {
			validate(mandatory(  optional('config'), mandatory(@encodings), @config_opts, check_https, qw/vault concurrency/, writable_journal('journal'),
				check_dir_or_relname, check_base_dir, mandatory('partsize'), check_max_size  ))
		};


		command 'purge-vault' => sub {
			validate(mandatory(
				optional('config'), mandatory(@encodings), @config_opts, check_https, qw/vault concurrency/,
				writable_journal(existing_journal('journal')),
				deprecated('dir'), filter_options, optional('dry-run')
			))
		};

		command 'restore' => sub {
			validate(mandatory(
				optional('config'), mandatory(@encodings), @config_opts, check_https, qw/dir vault max-number-of-files concurrency/,
				writable_journal(existing_journal('journal')),
				filter_options, optional('dry-run')
			))
		};

		command 'restore-completed' => sub {
			validate(mandatory(
				optional('config'), mandatory(@encodings), @config_opts, check_https, qw/dir vault concurrency/, existing_journal('journal'),
				filter_options, optional('dry-run'), http_download_options
			))
		};

		command 'check-local-hash' => sub {
			validate(mandatory(
				optional('config'), mandatory(@encodings), @config_opts, check_https, qw/dir/, existing_journal('journal'), deprecated('vault'),
				filter_options, optional('dry-run')
			))
		};

		command 'retrieve-inventory' => sub {
			validate(mandatory(optional('config'), mandatory(@encodings), 'request-inventory-format', @config_opts, check_https, qw/vault/))
		};

		command 'download-inventory' => sub {
			validate(mandatory(optional('config'), mandatory(@encodings), @config_opts, check_https, 'vault', empty_journal('new-journal')))
		};
	});
	return $c;
}

1;
__END__