diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-05-17 15:36:54 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-05-17 16:00:03 +0300 |
commit | 1dd78a678cfcf6f7653bb2c3af93f13208037dd1 (patch) | |
tree | 052b68c3792a05d5e124fd46543a065e4087501d /lib/App | |
parent | 622f1d002d7938498ef5c37d9cbcb158bb7a5fdb (diff) | |
download | glacier-1dd78a678cfcf6f7653bb2c3af93f13208037dd1.tar.gz glacier-1dd78a678cfcf6f7653bb2c3af93f13208037dd1.tar.bz2 |
Implement ls -d
Diffstat (limited to 'lib/App')
-rw-r--r-- | lib/App/Glacier/Command.pm | 80 | ||||
-rw-r--r-- | lib/App/Glacier/Command/CreateVault.pm | 12 | ||||
-rw-r--r-- | lib/App/Glacier/Command/ListVault.pm | 139 | ||||
-rw-r--r-- | lib/App/Glacier/DateTime.pm | 78 | ||||
-rw-r--r-- | lib/App/Glacier/Glob.pm | 63 | ||||
-rw-r--r-- | lib/App/Glacier/Job/FileRetrieval.pm | 13 | ||||
-rw-r--r-- | lib/App/Glacier/Timestamp.pm | 2 |
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; |