App-MtAws
4 results

 view release on metacpan or  search on metacpan

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

{
	my ($self, $block) = @_;
	local $context = $self; # TODO: create wrapper like 'localize sub ..'
	$block->();
}

sub decode_option_value
{
	my ($self, $val) = @_;
	my $enc = $self->{cmd_encoding}||confess;
	my $decoded = eval {decode($enc, $val, Encode::DIE_ON_ERR|Encode::LEAVE_SRC)};
	error("options_encoding_error", encoding => $enc) unless defined $decoded;
	$decoded;
}

sub decode_config_value
{
	my ($self, $val) = @_;
	my $enc = $self->{cfg_encoding}||confess;
	my $decoded = eval {decode($enc, $val, Encode::DIE_ON_ERR|Encode::LEAVE_SRC)};
	error("config_encoding_error", encoding => $enc) unless defined $decoded;
	$decoded;
}

sub get_encoding
{
	my ($name, $config, $options) = @_;
	return undef unless defined $name;
	my $res = undef;

	if (defined $config && defined($config->{$name})) {
		my $new_enc_obj = find_encoding($config->{$name});

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

			$optref||confess;
			warning('deprecated_option', option => $_->{name}, main => $self->{optaliasmap}->{$_->{name}})
				if $is_alias && $self->{deprecated_options}->{$_->{name}};

			error('already_specified_in_alias', ($optref->{original_option} lt $_->{name}) ?
				(a => $optref->{original_option}, b => $_->{name}) :
				(b => $optref->{original_option}, a => $_->{name})
			)
				if ((defined $optref->{value}) && !$optref->{list} && $optref->{source} eq 'option' );

			my $decoded;
			if ($optref->{binary}) {
				$decoded = $_->{value};
			} else {
				$decoded = $self->decode_option_value($_->{value});
				last unless defined $decoded;
			}

			if ($optref->{list}) {
				if (defined $optref->{value}) {
					push @{ $optref->{value} }, $decoded;
				} else {
					@{$optref}{qw/value source/} = ([ $decoded ], 'list');
				}
				push @{$self->{option_list} ||= []}, { name => $optref->{name}, value => $decoded };
			} else {
				# fill from options from command line
				@{$optref}{qw/value source original_option is_alias/} = ($decoded, 'option', $_->{name}, $is_alias);
			}
		}
	}
	my $command = undef;

	unless ($self->{errors}) {
		my $original_command = $command = shift @ARGV;
		if (defined($command)) {
			error("unknown_command", a => $original_command) unless
				$self->{commands}->{$command} ||

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


	unless ($self->{errors}) {
		if (defined $cfg) {
			for (keys %$cfg) {
				my ($optref, $is_alias) = $self->get_option_ref($_);
				if ($optref) {
					if ($optref->{list}) {
						error('list_options_in_config', option => $_);
					} elsif (!defined $optref->{value}) {
						# fill from config
						my $decoded = $optref->{binary} ? $cfg->{$_} : $self->decode_config_value($cfg->{$_});
						last unless defined $decoded;
						@{$optref}{qw/value source/} = ($decoded, 'config'); # TODO: support for array options??
					}
				} else {
					error('unknown_config_option', option => $_);
				}
			}
		}
	}
	unless ($self->{errors}) {

		for (values %{$self->{options}}) {

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

	my ($self, $marker) = @_;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs";

	$self->{params} = { completed => 'true' };
	$self->{params}->{marker} = $marker if defined($marker);

	$self->{method} = 'GET';

	my $resp = $self->perform_lwp();
	return $resp->decoded_content; # TODO: return reference?
}


# TODO: rename
sub retrieval_download_job
{
	my ($self, $jobid, $relfilename, $tempfile, $size, $journal_treehash) = @_;

	$journal_treehash||confess;
	$jobid||confess;

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

		calculated => $th, reported => $reported_th, filename => $filename, position => $position, size => $size;
		# TODO: better report relative filename

	my ($start, $end, $len) = $resp->header('Content-Range') =~ m!bytes\s+(\d+)\-(\d+)\/(\d+)!;

	confess unless defined($start) && defined($end) && $len;
	confess unless $end >= $start;
	confess unless $position == $start;
	confess unless $end_position == $end;

	return $resp ? 1 : undef; # $resp->decoded_content is undefined here as content_file used
}

sub retrieval_download_to_memory
{
	my ($self, $jobid) = @_;

	$jobid||confess;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs/$jobid/output";
	$self->{method} = 'GET';

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


sub list_vaults
{
	my ($self, $marker) = @_;

	$self->{url} = "/$self->{account_id}/vaults";
	$self->{params}->{marker} = $marker if defined($marker);
	$self->{method} = 'GET';

	my $resp = $self->perform_lwp();
	return $resp->decoded_content; # TODO: return reference?
}


sub _calc_data_hash
{
	my ($self) = @_;

	if (length(${$self->{dataref}}) <= 1048576) {
		$self->{data_sha256} = $self->{part_final_hash};
	} else {

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

=====================

x-amz-archive-description = 'mt2' <space> base64url(json_utf8({'filename': FILENAME, 'mtime': iso8601(MTIME)}))

Version 'mt1'
=====================

x-amz-archive-description = 'mt1' <space> base64url(latin1_to_utf8(json_utf8({'filename': FILENAME, 'mtime': iso8601(MTIME)})))

This format actually contains a bug - data is double encoded. However it does not affect data integrity. UTF-8 double encoded data can be
perfectly decoded (see http://www.j3e.de/linux/convmv/man/) - that's why the bug was unnoticed during one month.
This format was in use starting from version 0.80beta (2012-12-27) till 0.84beta (2013-01-28).

NOTES:
=====================

1) This specification assumes that in our programming language we have two different types of Strings: Byte string (byte sequence) and Character strings.
Byte string is sequence of octets. Character string is an internal representation of sequence of characters. Character strings cannot have encodings
by definition - it's internal, encoding is known to language implementation.

Some programming languages (like Ruby) have different model, when every string is a sequence of bytes with a known encoding (or no encoding at all).

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

		qq!andnd/asdasdf!,
		qq!andndasdasdf=!,
		qq!тест!,
		qq!тест test!,
		qq!тест=test!,
	) {
		my $result = App::MtAws::MetaData::_encode_b64(App::MtAws::MetaData::_encode_utf8($_));
		ok ($result eq _encode_base64url(encode("UTF-8", $_, Encode::DIE_ON_ERR|Encode::LEAVE_SRC)), 'match base64 encode');
		ok ($result !~ /[\r\n]/m, 'does not contain linefeed');
		ok ($result !~ /[\+\/\=]/m, 'does not contain + and /');
		my $redecoded = App::MtAws::MetaData::_decode_utf8(App::MtAws::MetaData::_decode_b64($result));

		#ok(utf8::is_utf8($_), "source should be utf8 $_");
		ok(utf8::is_utf8($redecoded), "recoded should be utf8");

		ok ($redecoded eq $_, 'reverse decodable');
	}
}


# test _encode_b64 dash and underscore
{
	for (
		qq!aaa_!,
		qq!bbb-!,
		qq!aa_-!,

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

		['директория/a/b/c/d','1352124178'],
		['директория/файл',1352124178],
		['директория/файл',0],
		['директория/файл','0'],
	) {
		my $result = App::MtAws::MetaData::_encode_json(App::MtAws::MetaData::_encode_filename_and_mtime($_->[0], $_->[1]));
		my $recoded = JSON::XS->new->utf8->allow_nonref->decode($result);
		ok ($result !~ /[\r\n]/m, 'no linefeed');
##		ok( $result =~ /\:\s*$_->[1]/, "result should contain mtime as numeric");
		is_deeply($recoded, { mtime => to_iso8601($_->[1]), filename => $_->[0]}, "jsone string should be json with correct filename and mtime");
		my $result_decoded =decode("UTF-8", $result, Encode::DIE_ON_ERR|Encode::LEAVE_SRC);
		ok ($result_decoded =~ /\Q$_->[0]\E/m, "json string should contain UTF without escapes");

		my ($filename, $mtime) = App::MtAws::MetaData::_decode_filename_and_mtime(App::MtAws::MetaData::_decode_json($result));
		ok ($filename eq $_->[0], 'filename match');
		ok ($mtime == $_->[1], 'mtime match');
	}
}

# test meta_encode/meta_decode with fixtures
{
	for (

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

		$old_strlen = $strlen;
	}
}

# test increment of length of resulting data
{
	for my $str1 (qw/ ! a b c d e f _ ß µ Ũ  а б в г д е ё ж з и к л м н о п р с т у ф ц ч ш щ э ю я А Б В Г Д Е Ё Ж З И К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Э Ю Я/) {
		for my $str2 (qw/a hello/, qq!file1/file2/file3/file4!, qq!длинный русский текст!, qq!/!) {
			my $source = $str1.$str2;
			my $encoded = App::MtAws::MetaData::meta_encode($source, 1234);
			my ($decoded, $mtime) = App::MtAws::MetaData::meta_decode($encoded);
			ok $source eq $decoded;
			ok $mtime = 1234;
		}
	}
}

sub test_undefined
{
	my ($str, $msg) = @_;
	ok !defined App::MtAws::MetaData::meta_decode($str), "$msg (scalar)";
	my @a = App::MtAws::MetaData::meta_decode($str);



( run in 0.397 second using v1.01-cache-2.11-cpan-26ccb49234f )