view release on metacpan or  search on metacpan

lib/App/Glacier/Bre.pm  view on Meta::CPAN

package App::Glacier::Bre;
use strict;
use warnings;
use parent 'Net::Amazon::Glacier';
use App::Glacier::HttpCatch;
use App::Glacier::Signature;
use Carp;
use version 0.77;
use LWP::UserAgent;
use JSON;

sub new {
    my ($class, %opts) = @_;
    my $region = (delete $opts{region} || _get_instore_region())
	or return $class->new_failed('availability region not supplied');
    my $access = delete $opts{access};
    my ($secret,$token);
    if (defined($access)) {
	$secret = delete $opts{secret}
	  	or $class->new_failed('secret not supplied');
    } else {
	($access, $secret, $token) = _get_instore_creds()
	    or return $class->new_failed('no credentials supplied');
    }
    my $self = $class->SUPER::new($region, $access, $secret);
    if ($token) {
	# Overwrite the 'sig' attribute.
	# FIXME: The attribute itself is not documented, so this 
	# method may fail if the internals of the base class change
	# in its future releases.
	# This approach works with Net::Amazon::Glacier 0.15
	$self->{sig} = new App::Glacier::Signature($self->{sig}, $token);
    }
    return $self;
}

sub new_failed {
    my ($class, $message) = @_;
    bless { _error => $message }, $class;
}

my $istore_base_url = "http://169.254.169.254/latest/";
my $istore_document_path = "dynamic/instance-identity/document";
my $istore_credentials_path = "meta-data/iam/security-credentials/";

sub _get_instore_region {
    my $ua = LWP::UserAgent->new(timeout => 10);
    my $response = $ua->get($istore_base_url . $istore_document_path);
    unless ($response->is_success) {
	return undef;
    }
    my $doc = JSON->new->decode($response->decoded_content);
    return $doc->{region};
}

sub _get_instore_creds {
    my $ua = LWP::UserAgent->new(timeout => 10);
    my $url = $istore_base_url . $istore_credentials_path;
    my $response = $ua->get($url);
    unless ($response->is_success) {
	return undef;
    }
    chomp(my $name = $response->decoded_content);
    $url .= $name;
    $response = $ua->get($url);
    unless ($response->is_success) {
	return undef;
    }
    my $doc = JSON->new->decode($response->decoded_content);
    return ($doc->{AccessKeyId}, $doc->{SecretAccessKey}, $doc->{Token});
}

# Fix bugs in Net::Amazon::Glacier 0.15
if (version->parse($Net::Amazon::Glacier::VERSION) <= version->parse('0.15')) {
    no strict 'refs';
    *{__PACKAGE__.'::list_vaults'} = \&list_vaults_fixed;
    *{__PACKAGE__.'::get_vault_notifications'} = \&get_vault_notifications_fixed;
}

sub _eval {
    my $self = shift;
    my $method = shift;
    my $wantarray = wantarray;
    my $ret = http_catch(sub {
	                    $wantarray ? [ $self->${\$method}(@_) ]