aboutsummaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-05-17 15:36:54 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2017-05-17 16:00:03 +0300
commit1dd78a678cfcf6f7653bb2c3af93f13208037dd1 (patch)
tree052b68c3792a05d5e124fd46543a065e4087501d /lib/App
parent622f1d002d7938498ef5c37d9cbcb158bb7a5fdb (diff)
downloadglacier-1dd78a678cfcf6f7653bb2c3af93f13208037dd1.tar.gz
glacier-1dd78a678cfcf6f7653bb2c3af93f13208037dd1.tar.bz2
Implement ls -d
Diffstat (limited to 'lib/App')
-rw-r--r--lib/App/Glacier/Command.pm80
-rw-r--r--lib/App/Glacier/Command/CreateVault.pm12
-rw-r--r--lib/App/Glacier/Command/ListVault.pm139
-rw-r--r--lib/App/Glacier/DateTime.pm78
-rw-r--r--lib/App/Glacier/Glob.pm63
-rw-r--r--lib/App/Glacier/Job/FileRetrieval.pm13
-rw-r--r--lib/App/Glacier/Timestamp.pm2
7 files changed, 381 insertions, 6 deletions
diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index d90bf76..3875a53 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -2,6 +2,7 @@ package App::Glacier::Command;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(usage_error
+ pod_usage_msg
EX_OK
EX_FAILURE
EX_USAGE
@@ -29,8 +30,12 @@ use App::Glacier::Config;
use Net::Amazon::Glacier;
use App::Glacier::HttpCatch;
use App::Glacier::DB::GDBM;
+use App::Glacier::Timestamp;
use Digest::SHA qw(sha256_hex);
use File::Path qw(make_path);
+use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
+use Pod::Usage;
+use Pod::Find qw(pod_where);
use constant {
EX_OK => 0,
@@ -210,6 +215,31 @@ sub invdb {
return $self->{_invdb}{$vault};
}
+sub describe_vault {
+ my ($self, $vault_name) = @_;
+ my $res = $self->glacier_eval('describe_vault', $vault_name);
+ if ($self->lasterr) {
+ if ($self->lasterr('code') == 404) {
+ return undef;
+ } else {
+ $self->abend(EX_FAILURE, "can't list vault: ",
+ $self->last_error_message);
+ }
+ }
+ return timestamp_unserialize($res);
+}
+
+sub directory {
+ my ($self, $vault_name) = @_;
+ unless ($self->{_dir}{$vault_name}) {
+ my $vault = $self->describe_vault($vault_name);
+ return undef unless $vault;
+ $self->{_dir}{$vault_name} =
+ new App::Glacier::Directory($self->invdb($vault_name));
+ }
+ return $self->{_dir}{$vault_name};
+}
+
sub error {
my ($self, @msg) = @_;
print STDERR "$self->{_progname}: " if $self->{_progname};
@@ -263,8 +293,58 @@ sub last_error_message {
return $self->lasterr('mesg') || $self->lasterr('text');
}
+# getopt(ARRAY, HASH)
+sub getopt {
+ my ($self, %opts) = @_;
+
+ GetOptions("hhh|?" => sub {
+ pod2usage(-message => pod_usage_msg($self),
+ -input => pod_where({-inc => 1}, ref($self)),
+ -exitstatus => EX_OK);
+ },
+ "help" => sub {
+ pod2usage(-input => pod_where({-inc => 1}, ref($self)),
+ -exitstatus => EX_OK,
+ -verbose => 2);
+ },
+ "usage" => sub {
+ pod2usage(-input => pod_where({-inc => 1}, ref($self)),
+ -exitstatus => EX_OK,
+ -verbose => 0);
+ },
+ %opts) or exit(EX_USAGE);
+}
+
sub usage_error {
new App::Glacier::Command(usage_error => \@_);
}
+sub pod_usage_msg {
+ my ($obj) = @_;
+ my %args;
+
+ my $msg = "";
+
+ open my $fd, '>', \$msg;
+
+ $args{-input} = pod_where({-inc => 1}, ref($obj)) if defined $obj;
+ pod2usage(-verbose => 99,
+ -sections => 'NAME',
+ -output => $fd,
+ -exitval => 'NOEXIT',
+ %args);
+
+ my @a = split /\n/, $msg;
+ if ($#a < 1) {
+ croak "missing or malformed NAME section for "
+ . (defined($obj) ? ref($obj): basename($0) );
+ }
+ $msg = $a[1];
+ $msg =~ s/^\s+//;
+ $msg =~ s/ - /: /;
+ return $msg;
+}
+
+
+
1;
diff --git a/lib/App/Glacier/Command/CreateVault.pm b/lib/App/Glacier/Command/CreateVault.pm
index e0e41bc..c53e47a 100644
--- a/lib/App/Glacier/Command/CreateVault.pm
+++ b/lib/App/Glacier/Command/CreateVault.pm
@@ -6,9 +6,19 @@ use App::Glacier::Command;
use parent qw(App::Glacier::Command);
use App::Glacier::HttpCatch;
+=head1 NAME
+
+glacier mkvault - create a Glacier vault
+
+=head1 SYNOPSIS
+
+B<glacier mkvault> I<NAME>
+
+=cut
+
sub run {
my $self = shift;
-
+
$self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
my $vault_name = shift;
$self->glacier_eval('create_vault', $vault_name);
diff --git a/lib/App/Glacier/Command/ListVault.pm b/lib/App/Glacier/Command/ListVault.pm
new file mode 100644
index 0000000..56c6a4a
--- /dev/null
+++ b/lib/App/Glacier/Command/ListVault.pm
@@ -0,0 +1,139 @@
+package App::Glacier::Command::ListVault;
+
+use strict;
+use warnings;
+use App::Glacier::Command;
+use parent qw(App::Glacier::Command);
+use App::Glacier::HttpCatch;
+use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
+use App::Glacier::DateTime;
+use App::Glacier::Timestamp;
+use App::Glacier::Glob;
+
+=head1 NAME
+
+glacier list - list vaults or archives
+
+=head1 SYNOPSIS
+
+B<glacier list>
+[B<-dl>]
+[I<VAULT>]
+[I<FILE>...]
+
+=cut
+
+sub getopt {
+ my ($self, %opts) = @_;
+ my %sortf = (
+ none => undef,
+ name => sub {
+ my ($a, $b) = @_;
+ $a->{VaultName} cmp $b->{VaultName}
+ },
+ time => sub {
+ my ($a, $b) = @_;
+ $a->{CreationDate}->epoch <=> $b->{CreationDate}->epoch;
+ },
+ size => sub {
+ my ($a, $b) = @_;
+ $a->{SizeInBytes} <=> $b->{SizeInBytes}
+ }
+ );
+ $self->{_options}{sort} = 'name';
+ my $rc = $self->SUPER::getopt(
+ 'd' => \$self->{_options}{d},
+ 'l' => \$self->{_options}{l},
+ 'sort=s' => \$self->{_options}{sort},
+ 't' => sub { $self->{_options}{sort} = 'time' },
+ 'S' => sub { $self->{_options}{sort} = 'size' },
+ 'h' => \$self->{_options}{h},
+ 'reverse|r' => \$self->{_options}{r},
+ 'time-style=s' => \$self->{_options}{time_style},
+ %opts);
+ return $rc unless $rc;
+ if (defined($self->{_options}{sort})) {
+ $self->abend(EX_USAGE, "unknowns sort field")
+ unless exists($sortf{$self->{_options}{sort}});
+ $self->{_options}{sort} = $sortf{$self->{_options}{sort}};
+ }
+ if (defined($self->{_options}{time_style})) {
+ eval {
+ my $x = new App::Glacier::DateTime(year=>1970);
+ $x->canned_format($self->{_options}{time_style});
+ };
+ if ($@) {
+ # FIXME: if ($@ =~ /unknown canned format/
+ $self->abend(EX_USAGE, "unrecognized time style: $self->{_options}{time_style}");
+ }
+ }
+}
+
+sub run {
+ my $self = shift;
+
+ if ($self->{_options}{d}) {
+ $self->list_vaults($self->get_vault_list(@_));
+ }
+}
+
+sub get_vault_list {
+ my $self = shift;
+
+ my $glob = new App::Glacier::Glob(@_);
+ if ($glob->is_literal) {
+ return ($self->describe_vault(@_));
+ } else {
+ my $res = $self->glacier_eval('list_vaults');
+ if ($self->lasterr) {
+ $self->abend(EX_FAILURE, "can't list vaults: ",
+ $self->last_error_message);
+ }
+ return map { timestamp_unserialize($_) }
+ $glob->filter(sub {
+ my ($x) = @_;
+ return $x->{VaultName}
+ }, @$res);
+ }
+}
+
+sub list_vaults {
+ my $self = shift;
+
+ foreach my $v (defined($self->{_options}{sort}) ?
+ sort {
+ &{$self->{_options}{sort}}
+ ($self->{_options}{r} ? ($b, $a) : ($a, $b))
+ } @_
+ : @_) {
+ $self->show_vault($v);
+ }
+}
+
+sub format_size {
+ my ($self, $size, $width) = @_;
+ my $suf = '';
+ if ($self->{_options}{h}) {
+ my @suffixes = ('K', 'M', 'G');
+ while ($size >= 1024 && @suffixes) {
+ $size /= 1024;
+ $suf = shift @suffixes;
+ }
+ }
+ return sprintf("%*d%s", ($width || 10) - length($suf), int($size), $suf);
+}
+
+sub show_vault {
+ my ($self, $vault) = @_;
+ if ($self->{_options}{l}) {
+ printf("%8s % 8d %s %-24s\n",
+ $self->format_size($vault->{SizeInBytes}),
+ $vault->{NumberOfArchives},
+ $vault->{CreationDate}->canned_format($self->{_options}{time_style}),
+ $vault->{VaultName});
+ } else {
+ print $vault->{VaultName},"\n";
+ }
+}
+
+1;
diff --git a/lib/App/Glacier/DateTime.pm b/lib/App/Glacier/DateTime.pm
new file mode 100644
index 0000000..f5033b1
--- /dev/null
+++ b/lib/App/Glacier/DateTime.pm
@@ -0,0 +1,78 @@
+package App::Glacier::DateTime;
+use strict;
+use warnings;
+use parent 'DateTime';
+
+use Carp;
+use DateTime;
+
+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}
+ {POSIX::strftime('%c',
+ $self->second,
+ $self->minute,
+ $self->hour,
+ $self->day,
+ $self->month - 1,
+ $self->year - 1900,
+ -1,
+ -1,
+ $self->is_dst())}gex;
+ if ($fmt !~ /(?<!%)%/) {
+ return $fmt;
+ } else {
+ return $self->SUPER::strftime($fmt)
+ }
+ }
+}
+
+sub _fmt_default {
+ my ($dt) = @_;
+ my $now = time;
+ $dt = $dt->epoch;
+ if ($dt < $now && $now - $dt < 6*31*86400) {
+ return '%b %d %H:%M';
+ } else {
+ return '%b %d %Y';
+ }
+}
+
+sub _fmt_iso {
+ my ($dt) = @_;
+ my $now = time;
+ $dt = $dt->epoch;
+ if ($dt < $now && $now - $dt < 6*31*86400) {
+ return '%m-%d %H:%M';
+ } else {
+ return '%Y-%m-%d';
+ }
+}
+
+my %format_can = (
+ default => \&_fmt_default,
+ iso => \&_fmt_iso,
+ 'long-iso' => '%Y-%m-%d %H:%M',
+ 'full-iso' => '%Y-%m-%d %H:%M:%S.%N %z',
+ locale => '%c'
+);
+
+sub canned_format {
+ my $self = shift;
+ my $fmt = shift || 'default';
+
+ if ($fmt =~ /^\+(.+)/) {
+ return $self->strftime($1);
+ } elsif (exists($format_can{$fmt})) {
+ $fmt = $format_can{$fmt};
+ $fmt = &{$fmt}($self) if ref($fmt) eq 'CODE';
+ return $self->strftime($fmt);
+ } else {
+ croak "unknown canned format $fmt"
+ }
+}
diff --git a/lib/App/Glacier/Glob.pm b/lib/App/Glacier/Glob.pm
new file mode 100644
index 0000000..6859e33
--- /dev/null
+++ b/lib/App/Glacier/Glob.pm
@@ -0,0 +1,63 @@
+package App::Glacier::Glob;
+use Exporter;
+use parent 'Exporter';
+use Carp;
+
+sub glob2pat {
+ return undef unless @_;
+ my %patmap = (
+ '*' => '.*',
+ '?' => '.',
+ '[' => '[',
+ ']' => ']',
+ );
+ return '^'
+ . join('|', map { s{(.)} { $patmap{$1} || "\Q$1\E" }gex; "(?:$_)" } @_)
+ . '$';
+}
+
+sub new {
+ my $class = shift;
+ my $rx = glob2pat(@_);
+ my $self = bless { }, $class;
+ if (@_ == 1 && $_[0] !~ /[][*?]/) {
+ $self->{_rx} = $_[0];
+ $self->{_is_literal} = 1;
+ } elsif ($rx) {
+ $self->{_rx} = $rx;
+ };
+ return $self;
+}
+
+sub matches_all {
+ my ($self) = @_;
+ return ! defined $self->{_rx};
+}
+
+sub is_literal {
+ my ($self) = @_;
+ return $self->{_is_literal};
+}
+
+sub match {
+ my ($self, $s) = @_;
+ return 1 if $self->matches_all;
+ return $s eq $self->{_rx} if $self->is_literal;
+ return $s =~ /$self->{_rx}/;
+}
+
+sub filter {
+ my $self = shift;
+ my $fun = shift;
+ croak "first argument must be a sub" unless ref($fun) eq 'CODE';
+ return @_ if $self->matches_all;
+ return grep { $self->match(&{$fun}($_)) } @_;
+}
+
+sub grep {
+ my $self = shift;
+ return @_ if $self->matches_all;
+ return grep { $self->match($_) } @_;
+}
+
+1;
diff --git a/lib/App/Glacier/Job/FileRetrieval.pm b/lib/App/Glacier/Job/FileRetrieval.pm
index 012f813..717b082 100644
--- a/lib/App/Glacier/Job/FileRetrieval.pm
+++ b/lib/App/Glacier/Job/FileRetrieval.pm
@@ -11,14 +11,19 @@ sub new {
my $dir = $cmd->directory($vault);
unless ($dir) {
- # FIXME: what?
+ $com->abend(EX_TEMPFAIL,
+ "nothing is known about vault $vault;"
+ "please get directory listing first");
}
- my $archive = $dir->lookup($file, \$version);
+ my $archive;
+ ($archive, $version) = $dir->lookup($file, $version);
unless ($archive) {
- # What?
+ $version = 1 unless defined $version;
+ $com->abend(EX_NOINPUT, "$vault:$file;$version not found;"
+ "make sure directory listing is up-to-date");
}
my $descr = "Retrieval of $file;$version";
- return $class->SUPER::new($cmd, $vault, $archive, $descr);
+ return $class->SUPER::new($cmd, $vault, $archive->{ArchiveId}, $descr);
}
diff --git a/lib/App/Glacier/Timestamp.pm b/lib/App/Glacier/Timestamp.pm
index a71864e..d89d8b4 100644
--- a/lib/App/Glacier/Timestamp.pm
+++ b/lib/App/Glacier/Timestamp.pm
@@ -10,7 +10,7 @@ sub _to_timestamp {
my $obj = shift;
foreach my $attr (@_) {
if (exists($obj->{$attr}) && defined($obj->{$attr})) {
- $obj->{$attr} = DateTime::Format::ISO8601->parse_datetime($obj->{$attr});
+ $obj->{$attr} = bless DateTime::Format::ISO8601->parse_datetime($obj->{$attr}), 'App::Glacier::DateTime';
}
}
return $obj;

Return to:

Send suggestions and report system problems to the System administrator.