SUPER:: results from the CPAN

SUPER::

App-Glacier

view release on metacpan or search on metacpan

	$self->usage_error("unrecognized command");
    } elsif ($#v > 0) {
	$self->usage_error("ambiguous command: ".join(', ', @v));
    }
    return $self->getcom($v[0]);
}

sub new {
    my ($class, $argref) = shift;

    my $self = $class->SUPER::new(
	$argref,
	optmap => {
	'config-file|f=s' => 'config',
	'account=s' => 'account',
	'region=s' => 'region'
    });

    my $com = shift @{$self->argv}
	or $self->usage_error("no command name");
    &{$self->getcom($com)}($self->argv,

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

	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;
}

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

	$config_file = -f '/etc/glacier.conf'
	                ? '/etc/glacier.conf' : '/dev/null';
    }
    my $account = delete $_{account};
    my $region = delete $_{region};

    my $debug = delete $_{debug};
    my $dry_run = delete $_{dry_run};
    my $progname = delete $_{progname};
    
    my $self = $class->SUPER::new($argref, %_);

    $self->{_debug} = $debug if $debug;
    $self->{_dry_run} = $dry_run if $dry_run;
    $self->progname($progname) if $progname;
    
    $self->{_config} = new App::Glacier::Config($config_file,
						debug => $self->{_debug},
						parameters => \%parameters);
    exit(EX_CONFIG) unless $self->{_config}->parse();

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

	$self->abend(EX_CONFIG, $self->{_glacier}->last_error_message);
    }
    return $self;
}

# Produce a semi-flat clone of $orig, blessing it into $class.
# The clone is semi-flat, because it shares the parsed configuration and
# the glacier object with the $orig.
sub clone {
    my ($class, $orig) = @_;
    my $self = $class->SUPER::clone($orig);
    $self->{_config} = $orig->config; 
    $self->{_glacier} = $orig->{_glacier};
    $self->{_jobdb} = $orig->{_jobdb};
    $self
}

sub option {
    my ($self, $opt, $val) = @_;
    if (defined($val)) {
	$self->{_options}{$opt} = $val;

lib/App/Glacier/Command/Get.pm view on Meta::CPAN

=cut

use constant {
    IFEXISTS_OVERWRITE => 0,
    IFEXISTS_KEEP => 1,
    IFEXISTS_ASK => 2,
};
    
sub new {
    my ($class, $argref, %opts) = @_;
    my $self = $class->SUPER::new(
	$argref,
	optmap => {
	    'interactive|i' => sub {
		$_[0]->{_options}{ifexists} = IFEXISTS_ASK
	    },
	    'force|f' => sub {
		$_[0]->{_options}{ifexists} = IFEXISTS_OVERWRITE
	    },
	    'no-clobber|keep|k' => sub {
		$_[0]->{_options}{ifexists} = IFEXISTS_KEEP

lib/App/Glacier/Command/Jobs.pm view on Meta::CPAN


=head1 SEE ALSO

B<glacier>(1),    
B<strftime>(3).
    
=cut    

sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
	$argref,
        optmap => {
	    'time-style=s' => sub { $_[0]->set_time_style_option($_[2]) },
	    'long|l+' => 'long',
	    'cached|c' => 'cached',
	},
	%opts);
}

sub run {

lib/App/Glacier/Command/ListVault.pm view on Meta::CPAN

	},
	time => sub {
	    my ($a, $b) = @_;
	    $a->{CreationDate}->epoch <=> $b->{CreationDate}->epoch;
	},
	size => sub {
	    my ($a, $b) = @_;
	    $a->{Size} <=> $b->{Size}
	}
    );
    my $self = $class->SUPER::new(
	$argref,
	optmap => {
	    'cached|c' => 'cached',
	    'directory|d' => 'd',
	    'l' => 'l',
	    'sort=s' => 'sort',
	    't' => sub { $_[0]->{_options}{sort} = 'time' },
	    'S' => sub { $_[0]->{_options}{sort} = 'size' },
	    'U' => sub { $_[0]->{_options}{sort} = 'none' },
	    'human-readable|h' => 'h',

lib/App/Glacier/Command/Purge.pm view on Meta::CPAN

=back
    
=head1 SEE ALSO

B<glacier>(1).    
    
=cut

sub new {
    my ($class, $argref, %opts) = @_;
    my $self = $class->SUPER::new(
	$argref,
	optmap => {
	    'interactive|i' => 'interactive',
	    'force|f' => sub { $_[0]->{_options}{interactive} = 0 }
	},
	%opts);
    $self->{_options}{interactive} //= 1;
    $self
}

lib/App/Glacier/Command/Put.pm view on Meta::CPAN

=back    

=head1 SEE ALSO

B<glacier>(1).
    
=cut    

sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
	$argref,
	optmap => {
	    'jobs|j=i' => 'jobs',
	    'quiet|q' => 'quiet',
	    'rename|r' => 'rename'
	}, %opts);
}

sub run {
    my $self = shift;

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

=back

=head1 SEE ALSO

B<glacier>(1).    
    
=cut

sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
	$argref,
	optmap => {
	    'force|f' => 'force',
	    'delete|d' => 'delete'
	},
	%opts);
}

sub run {
    my $self = shift;

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

use warnings;
use parent 'DateTime';

use Carp;
use DateTime;

sub new {
    my ($class, @opts) = shift;
    unless (@opts) {
	my ($second, $minute, $hour, $day, $month, $year) = gmtime;
	return $class->SUPER::new(year => 1900 + $year,
				  month => $month + 1,
				  day => $day,
				  hour => $hour,
				  minute => $minute,
				  second => $second);
    }
    return $class->SUPER::new(@_);
}

sub strftime {
    my $self = shift;
    if (@_ > 1) {
	return map { $self->strftime($_) } @_;
    } else {
	my $fmt = shift;
	# DateTime::strftime misinterprets %c. so handle it separately
	$fmt =~ s{(?<!%)%c}

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

		                  $self->day,
		                  $self->month - 1,
		                  $self->year - 1900,
		                  -1,
		                  -1,
		                  $self->is_dst())}gex;
	if ($fmt !~ /(?<!%)%/) {
	    return $fmt;
	} else {
#	    print "FMT ".$self->year."-".$self->month."-".$self->day."-".$self->hour.';'.$self->minute."\n";
	    return $self->SUPER::strftime($fmt)
	}
    }
}

sub _fmt_default {
    my ($dt) = @_;
    my $now = new App::Glacier::DateTime;
    $dt = $dt->epoch;
    $now = $now->epoch;
    if ($dt < $now && $now - $dt < 6*31*86400) {

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

our @EXPORT_OK = qw(DIR_UPTODATE DIR_PENDING DIR_OUTDATED);
our %EXPORT_TAGS = ( status => [ qw(DIR_UPTODATE DIR_PENDING DIR_OUTDATED) ] );

use constant DB_INFO_KEY => ';00INFO';

sub new {
    my ($class, $backend, $vault, $glacier, %opts) = @_;
    (my $vault_name = $vault) =~
	s/([^A-Za-z_0-9\.-])/sprintf("%%%02X", ord($1))/gex;
    map { $opts{$_} =~ s/\$(?:vault|\{vault\})/$vault_name/g } keys %opts;
    my $self = $class->SUPER::new($backend,
				  %opts,
		       create => sub { $glacier->describe_vault($vault_name) },
    );
    if ($self) {
	$self->{_vault} = $vault;
	$self->{_glacier} = $glacier;
    }
    return $self;
}

sub vault { shift->{_vault} }
sub glacier { shift->{_glacier} }

# locate(FILE, VERSION)
sub locate {
    my ($self, $file, $version) = @_;
    $version = 1 unless defined $version;
    my $rec = $self->SUPER::retrieve($file);
    return undef unless defined $rec || $version-1 > $#{$rec};
    return wantarray ? ($rec->[$version-1], $version) : $rec->[$version-1];
}

sub info {
    my ($self, $key) = @_;
    my $rec = $self->retrieve(DB_INFO_KEY);
    return undef unless defined($rec);
    return $rec->{$key};
}

sub set_info {
    my ($self, $key, $val) = @_;
    my $rec = $self->retrieve(DB_INFO_KEY) || {};
    $rec->{$key} = $val;
    $self->SUPER::store(DB_INFO_KEY, $rec);
}

sub last_sync_time {
    my ($self) = @_;
    return $self->info('SyncTimeStamp');
}

sub update_sync_time {
    my ($self) = @_;
    $self->set_info('SyncTimeStamp', time);
}

sub foreach {
    my ($self, $code) = @_;
    $self->SUPER::foreach(sub {
	                      my ($k, $v) = @_;
			      &{$code}($k, $v) unless $k eq DB_INFO_KEY;
			  });
}
	    
sub add_version {
    my ($self, $file_name, $val) = @_;
    my $rec = $self->retrieve($file_name);
    my $i;
    if ($rec) {
	my $t = $val->{CreationDate}->epoch;
	for ($i = 0; $i <= $#{$rec}; $i++) {
	    last if $t >= $rec->[$i]{CreationDate}->epoch;
	}
	splice(@{$rec}, $i, 0, $val);
    } else {
	$i = 0;
	$rec = [ $val ];
    }
    $self->SUPER::store($file_name, $rec);
    return $i + 1;
}

sub delete_version {
    my ($self, $file_name, $ver) = @_;
    $ver--;
    my $rec = $self->retrieve($file_name);
    if ($rec && $ver <= $#{$rec}) {
	splice(@{$rec}, $ver, 1);
	if (@{$rec}) {
	    $self->SUPER::store($file_name, $rec);
	} else {
	    $self->delete($file_name);
	}
    } else {
	++$ver;
	croak "can't remove $file_name;$ver: no such version";
    }
}

sub tempname {

lib/App/Glacier/Directory/GDBM.pm view on Meta::CPAN

package App::Glacier::Directory::GDBM;
use parent 'App::Glacier::DB::GDBM';

sub configtest {
    my ($class, $cfg, @path) = @_;
    unless ($cfg->isset(@path, 'file')) {
	$cfg->set(@path, 'file', '/var/lib/glacier/inv/$vault.db');
    }
    $class->SUPER::configtest($cfg, @path);
}

1;

lib/App/Glacier/Job/ArchiveRetrieval.pm view on Meta::CPAN


use parent qw(App::Glacier::Job);
use App::Glacier::Core;
use Carp;

# new(CMD, VAULT, ARCHIVE[, description => DESCR, OPTS...])
sub new {
    croak "bad number of arguments" if $#_ < 3;
    my ($class, $cmd, $vault, $archive, %opts) = @_;
    my $descr = delete $opts{description};
    my $self = $class->SUPER::new(
	$cmd,
	$vault,
	$vault . ':' . $archive,
	%opts
	);
    $self->{_archive} = $archive;
    $self->{_descr} = $descr;
    return $self;
}

lib/App/Glacier/Job/FileRetrieval.pm view on Meta::CPAN

		    "nothing is known about vault $vault; please get directory listing first");
    }
    my $archive;
    ($archive, $version) = $dir->locate($file, $version);
    unless ($archive) {
	$version = 1 unless defined $version;
	$cmd->abend(EX_NOINPUT,
		    "$vault:$file;$version not found; make sure directory listing is up-to-date");
    }
    
    my $self = $class->SUPER::new($cmd, $vault, $archive->{ArchiveId},
				  description => "Retrieval of $file;$version",
				  ttl => $cmd->cfget(qw(database job ttl)));
    $self->{_filename} = $file;
    $self->{_fileversion} = $version;
    return $self;
}

sub file_name {
    my ($self, $full) = @_;
    if ($full) {

lib/App/Glacier/Job/InventoryRetrieval.pm view on Meta::CPAN

use warnings;

use parent qw(App::Glacier::Job);
use App::Glacier::Core;
use Carp;

# new(CMD, VAULT)
sub new {
    croak "bad number of arguments" unless $#_ >= 2;
    my ($class, $cmd, $vault, %opts) = @_;
    return $class->SUPER::new(
	$cmd, $vault, $vault,
	ttl => $cmd->cfget(qw(database inv ttl)),
	%opts);
}

sub init {
    my $self = shift;
    my $jid = $self->glacier->Initiate_inventory_retrieval(
		          $self->vault,
		          'JSON',

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

package App::Glacier::Roster;
use parent 'App::Glacier::DB';

sub foreach {
    my ($self, $fun) = @_;
    $self->SUPER::foreach(sub {
	my ($key, $descr) = @_;
	(my $vault = $descr->{VaultARN}) =~ s{.*:vaults/}{};
	&{$fun}($key, $descr, $vault);
    });
}	

1;

lib/App/Glacier/Roster/GDBM.pm view on Meta::CPAN

package App::Glacier::Roster::GDBM;
use parent 'App::Glacier::DB::GDBM';

sub configtest {
    my ($class, $cfg, @path) = @_;
    unless ($cfg->isset(@path, 'file')) {
	$cfg->set(@path, 'file', '/var/lib/glacier/job.db');
    }
    $class->SUPER::configtest($cfg, @path);
}

1;

( run in 2.234 seconds using v1.01-cache-2.11-cpan-94b05bcf43c )