aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2018-03-06 00:23:34 +0200
committerSergey Poznyakoff <gray@gnu.org>2018-03-06 00:57:23 +0200
commit86fb141c932c2305dbb096db36c929f4931f0c04 (patch)
tree64a65ac2b268c5ed83799c9cdcf9deda50baa128 /lib
parentf25b98d6b4080b9caad8ca586fc20483aac68a3b (diff)
downloadglacier-86fb141c932c2305dbb096db36c929f4931f0c04.tar.gz
glacier-86fb141c932c2305dbb096db36c929f4931f0c04.tar.bz2
Provide a core class. Change inheritance graph.
* lib/App/Glacier/Core.pm: New file. * Makefile.PL: Get abstract and version from lib/App/Glacier.pm * glacier: Change App::Glacier creation. * lib/App/Glacier.pm: Inherit from App::Glacier::Core. * lib/App/Glacier/Command.pm: Likewise. Rewrite constructor. * lib/App/Glacier/Command/CreateVault.pm: Change run() method. * lib/App/Glacier/Command/DeleteFile.pm: Likewise. * lib/App/Glacier/Command/DeleteVault.pm: Likewise. * lib/App/Glacier/Command/Get.pm: Rewrite getopt method as new(). Change the run() method. * lib/App/Glacier/Command/Jobs.pm: Likewise. * lib/App/Glacier/Command/ListVault.pm: Likewise. * lib/App/Glacier/Command/Purge.pm: Likewise. * lib/App/Glacier/Command/Put.pm: Likewise. * lib/App/Glacier/Command/Sync.pm: Likewise. * lib/App/Glacier/Config.pm (new): Initialize debug and ci. * lib/App/Glacier/Job.pm: Inherit from App::Glacier::Core. * lib/App/Glacier/Job/FileRetrieval.pm: Likewise.
Diffstat (limited to 'lib')
-rw-r--r--lib/App/Glacier.pm63
-rw-r--r--lib/App/Glacier/Command.pm190
-rw-r--r--lib/App/Glacier/Command/CreateVault.pm7
-rw-r--r--lib/App/Glacier/Command/DeleteFile.pm11
-rw-r--r--lib/App/Glacier/Command/DeleteVault.pm9
-rw-r--r--lib/App/Glacier/Command/Get.pm42
-rw-r--r--lib/App/Glacier/Command/Jobs.pm21
-rw-r--r--lib/App/Glacier/Command/ListVault.pm43
-rw-r--r--lib/App/Glacier/Command/Purge.pm23
-rw-r--r--lib/App/Glacier/Command/Put.pm30
-rw-r--r--lib/App/Glacier/Command/Sync.pm23
-rw-r--r--lib/App/Glacier/Config.pm9
-rw-r--r--lib/App/Glacier/Core.pm232
-rw-r--r--lib/App/Glacier/Job.pm2
-rw-r--r--lib/App/Glacier/Job/FileRetrieval.pm2
15 files changed, 406 insertions, 301 deletions
diff --git a/lib/App/Glacier.pm b/lib/App/Glacier.pm
index 7cacd4a..9e4fbb1 100644
--- a/lib/App/Glacier.pm
+++ b/lib/App/Glacier.pm
@@ -1,13 +1,12 @@
package App::Glacier;
use strict;
use warnings;
+use parent 'App::Glacier::Core';
use File::Basename;
use Net::Amazon::Glacier;
-use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
-use Pod::Usage;
-use Pod::Man;
use App::Glacier::Command;
use File::Basename;
+use Carp;
our $VERSION = '1.00';
@@ -52,54 +51,46 @@ my %comtab = (
);
sub getcom {
- my ($com, %args) = @_;
-
+ my ($self, $com) = @_;
+
while (defined($comtab{$com}) and ref($comtab{$com}) ne 'CODE') {
$com = $comtab{$com};
}
- die "internal error: unresolved command alias" unless defined $com;
- return &{$comtab{$com}}(%args) if defined $comtab{$com};
+ croak "internal error: unresolved command alias" unless defined $com;
+ return $comtab{$com} if exists $comtab{$com};
my @v = map { /^$com/ ? $_ : () } sort keys %comtab;
if ($#v == -1) {
- usage_error("unrecognized command");
+ $self->usage_error("unrecognized command");
} elsif ($#v > 0) {
- usage_error("ambiguous command: ".join(', ', @v));
+ $self->usage_error("ambiguous command: ".join(', ', @v));
}
- return getcom($v[0]);
+ return $self->getcom($v[0]);
}
sub new {
- my $class = shift;
-
+ my ($class, $argref) = shift;
my %args;
-
- GetOptions("hhh|?" => sub {
- pod2usage(-message => pod_usage_msg(),
- -exitstatus => EX_OK);
- },
- "help" => sub {
- pod2usage(-exitstatus => EX_OK, -verbose => 2);
- },
- "usage" => sub {
- pod2usage(-exitstatus => EX_OK, -verbose => 0);
- },
- "debug|d" => sub { $args{debug}++ },
- "dry-run|n" => sub { $args{dry_run} = 1 },
- "config-file|f=s" => sub { $args{config} = $_[1] },
- "account=s" => sub { $args{account} = $_[1] },
- "region=s" => sub { $args{region} = $_[1] }
- ) or exit(EX_USAGE);
-
- usage_error "no command name" unless @ARGV;
- usage_error "no command given" if $#ARGV == -1;
-
- getcom(shift @ARGV, %args);
+ my $self = $class->SUPER::new(
+ $argref,
+ optmap => {
+ 'config-file|f=s' => sub { $args{config} = $_[1] },
+ 'account=s' => sub { $args{account} = $_[1] },
+ 'region=s' => sub { $args{region} = $_[1] }
+ });
+ my $com = shift @{$self->argv}
+ or $self->usage_error("no command name");
+ &{$self->getcom($com)}($self->argv,
+ debug => $self->{_debug},
+ dry_run => $self->dry_run,
+ progname => $self->progname,
+ %args);
}
__END__
+
=head1 NAME
-glacier - command line utility for accessing Amazon Glacier storage
+App::Glacier, glacier - command line utility for accessing Amazon Glacier storage
=head1 SYNOPSIS
@@ -120,7 +111,7 @@ I<COMMAND> [I<OPTIONS>] I<ARG>...
Command line tool for working with the Amazon Glacier storage. The I<COMMAND>
instructs it what kind of manipulation is required. Its action can be
modified by I<OPTIONS> supplied after the command name. Options occurring
-before it, affect the behavior of the program as a whole and are common
+before it affect the behavior of the program as a whole and are common
for all commands.
The following is a short summary of existing commands. For a detailed
diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 136fc50..3267c01 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -1,29 +1,10 @@
package App::Glacier::Command;
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw(usage_error
- pod_usage_msg
- EX_OK
- EX_FAILURE
- EX_USAGE
- EX_DATAERR
- EX_NOINPUT
- EX_NOUSER
- EX_NOHOST
- EX_UNAVAILABLE
- EX_SOFTWARE
- EX_OSERR
- EX_OSFILE
- EX_CANTCREAT
- EX_IOERR
- EX_TEMPFAIL
- EX_PROTOCOL
- EX_NOPERM
- EX_CONFIG);
use strict;
use warnings;
use Carp;
+use App::Glacier::Core;
+use parent 'App::Glacier::Core';
use File::Basename;
use App::Glacier::EclatCreds;
use App::Glacier::Config;
@@ -35,29 +16,6 @@ use App::Glacier::Directory;
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,
- EX_FAILURE => 1,
- EX_USAGE => 64,
- EX_DATAERR => 65,
- EX_NOINPUT => 66,
- EX_NOUSER => 67,
- EX_NOHOST => 68,
- EX_UNAVAILABLE => 69,
- EX_SOFTWARE => 70,
- EX_OSERR => 71,
- EX_OSFILE => 72,
- EX_CANTCREAT => 73,
- EX_IOERR => 74,
- EX_TEMPFAIL => 75,
- EX_PROTOCOL => 76,
- EX_NOPERM => 77,
- EX_CONFIG => 78
-};
use constant MB => 1024*1024;
@@ -137,52 +95,24 @@ my %parameters = (
sub new {
my $class = shift;
+ my $argref = shift;
local %_ = @_;
- my $self = bless {
- _debug => 0,
- _dry_run => 0
- }, $class;
- my $v;
- my $account;
- my $region;
-
- if ($v = delete $_{progname}) {
- $self->{_progname} = $v;
- } else {
- $self->{_progname} = basename($0);
- }
- if ($v = delete $_{debug}) {
- $self->{_debug} = $v;
- }
+ my $config_file = delete $_{config}
+ || $ENV{GLACIER_CONF}
+ || "/etc/glacier.conf";
+ my $account = delete $_{account};
+ my $region = delete $_{region};
- if ($v = delete $_{dry_run}) {
- $self->{_dry_run} = $v;
- $self->{_debug}++;
- }
-
- if ($v = delete $_{usage_error}) {
- $self->abend(EX_USAGE, @$v);
- }
+ my $debug = delete $_{debug};
+ my $dry_run = delete $_{dry_run};
+ my $progname = delete $_{progname};
- if ($v = delete $_{account}) {
- $account = $v;
- }
-
- if ($v = delete $_{region}) {
- $region = $v;
- }
+ my $self = bless $class->SUPER::new($argref, %_), $class;
- my $config_file;
- if ($v = delete $_{config}) {
- $config_file = $v;
- } else {
- $config_file = $ENV{GLACIER_CONF} || "/etc/glacier.conf";
- }
-
- if (keys(%_)) {
- croak "unrecognized parameters: ".join(', ', keys(%_));
- }
+ $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},
@@ -207,15 +137,19 @@ sub new {
unless ($self->{_config}->isset(qw(glacier access))
&& $self->{_config}->isset(qw(glacier secret)));
}
-
- $self->{_config}->set(qw(glacier region), $region || 'eu-west-1');
+ if ($region) {
+ $self->{_config}->set(qw(glacier region), $region);
+ } elsif (!$self->{_config}->isset(qw(glacier region))) {
+ $self->{_config}->set(qw(glacier region), 'eu-west-1');
+ }
+
$self->{_glacier} = new Net::Amazon::Glacier(
$self->{_config}->get(qw(glacier region)),
$self->{_config}->get(qw(glacier access)),
$self->{_config}->get(qw(glacier secret))
);
-
+
return $self;
}
@@ -304,32 +238,6 @@ sub cf_transfer_param {
|| $self->cfget('transfer', $param);
}
-sub error {
- my ($self, @msg) = @_;
- print STDERR "$self->{_progname}: " if $self->{_progname};
- print STDERR "@msg\n";
-}
-
-sub debug {
- my ($self, $l, @msg) = @_;
- if ($self->{_debug} >= $l) {
- print STDERR "$self->{_progname}: " if $self->{_progname};
- print STDERR "DEBUG: ";
- print STDERR "@msg\n";
- }
-}
-
-sub dry_run {
- my $self = shift;
- return $self->{_dry_run};
-}
-
-sub abend {
- my ($self, $code, @msg) = @_;
- $self->error(@msg);
- exit $code;
-}
-
sub run {
my $self = shift;
$self->abend(EX_SOFTWARE, "command not implemented");
@@ -378,28 +286,6 @@ sub getyn {
return $in =~ /^[yY]/;
}
-# 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 set_time_style_option {
my ($self, $style) = @_;
@@ -418,37 +304,5 @@ sub format_date_time {
my ($self, $obj, $field) = @_;
return $obj->{$field}->canned_format($self->{_options}{time_style});
}
-
-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 d4ef5aa..ce96480 100644
--- a/lib/App/Glacier/Command/CreateVault.pm
+++ b/lib/App/Glacier/Command/CreateVault.pm
@@ -2,7 +2,7 @@ package App::Glacier::Command::CreateVault;
use strict;
use warnings;
-use App::Glacier::Command;
+use App::Glacier::Core;
use parent qw(App::Glacier::Command);
use App::Glacier::HttpCatch;
@@ -27,8 +27,9 @@ B<glacier>(1).
sub run {
my $self = shift;
- $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
- my $vault_name = shift;
+ $self->abend(EX_USAGE, "only one argument expected")
+ unless $self->command_line == 1;
+ my $vault_name = ($self->command_line)[0];
$self->glacier_eval('create_vault', $vault_name);
if ($self->lasterr) {
$self->abend(EX_FAILURE, "can't create: ", $self->last_error_message);
diff --git a/lib/App/Glacier/Command/DeleteFile.pm b/lib/App/Glacier/Command/DeleteFile.pm
index 93b009b..e6a127e 100644
--- a/lib/App/Glacier/Command/DeleteFile.pm
+++ b/lib/App/Glacier/Command/DeleteFile.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use App::Glacier::Command::ListVault;
use parent qw(App::Glacier::Command::ListVault);
-use App::Glacier::Command;
+use App::Glacier::Core;
use App::Glacier::HttpCatch;
=head1 NAME
@@ -32,13 +32,14 @@ B<glacier>(1).
sub run {
my $self = shift;
-
- $self->abend(EX_USAGE, "at least two arguments expected") unless @_ >= 2;
- my $vault_name = shift;
+ my @argv = $self->command_line;
+ $self->abend(EX_USAGE, "at least two arguments expected")
+ unless @argv >= 2;
+ my $vault_name = shift @argv;
my $dir = $self->directory($vault_name);
my $error = 0;
my $success = 0;
- foreach my $ref (@{$self->get_vault_inventory($vault_name, @_)}) {
+ foreach my $ref (@{$self->get_vault_inventory($vault_name, @argv)}) {
$self->glacier_eval('delete_archive', $vault_name, $ref->{ArchiveId});
if ($self->lasterr) {
$self->error(EX_FAILURE,
diff --git a/lib/App/Glacier/Command/DeleteVault.pm b/lib/App/Glacier/Command/DeleteVault.pm
index bd528cb..94246e2 100644
--- a/lib/App/Glacier/Command/DeleteVault.pm
+++ b/lib/App/Glacier/Command/DeleteVault.pm
@@ -2,7 +2,7 @@ package App::Glacier::Command::DeleteVault;
use strict;
use warnings;
-use App::Glacier::Command;
+use App::Glacier::Core;
use parent qw(App::Glacier::Command);
use App::Glacier::HttpCatch;
@@ -27,11 +27,12 @@ B<glacier>(1).
sub run {
my $self = shift;
- $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
- my $vault_name = shift;
+ $self->abend(EX_USAGE, "one argument expected")
+ unless $self->command_line == 1;
+ my $vault_name = ($self->command_line)[0];
$self->glacier_eval('delete_vault', $vault_name);
if ($self->lasterr) {
- $self->abend(EX_FAILURE, "can't create: ", $self->last_error_message);
+ $self->abend(EX_FAILURE, "can't delete: ", $self->last_error_message);
} else {
my $dir = $self->directory($vault_name);
$dir->drop
diff --git a/lib/App/Glacier/Command/Get.pm b/lib/App/Glacier/Command/Get.pm
index 134a87c..c7199e3 100644
--- a/lib/App/Glacier/Command/Get.pm
+++ b/lib/App/Glacier/Command/Get.pm
@@ -3,7 +3,7 @@ use strict;
use warnings;
use threads;
use threads::shared;
-use App::Glacier::Command;
+use App::Glacier::Core;
use App::Glacier::Job::FileRetrieval;
use App::Glacier::DateTime;
use App::Glacier::Progress;
@@ -18,12 +18,13 @@ glacier get - download file from a vault
=head1 SYNOPSIS
B<glacier put>
-[B<-fiqt>]
+[B<-fikqt>]
[B<--force>]
[B<--interactive>]
[B<-j> I<NJOBS>]
[B<--jobs=>I<NJOBS>]
[B<--no-clobber>]
+[B<--keep>]
[B<--quiet>]
[B<--test>]
I<VAULT>
@@ -58,7 +59,7 @@ The default is configured by the B<transfer.download.jobs> configuration
statement. If absent, the B<transfer.jobs> statement is used. The
default value is 16.
-=item B<--no-clobber>
+=item B<-k>, B<--keep>, B<--no-clobber>
Never overwrite existing files.
@@ -85,24 +86,35 @@ use constant {
IFEXISTS_ASK => 2,
};
-sub getopt {
- my ($self, %opts) = @_;
- $self->{_options}{ifexists} = IFEXISTS_OVERWRITE; # Default
- $self->SUPER::getopt(
- 'interactive|i' => sub { $self->{_options}{ifexists} = IFEXISTS_ASK },
- 'force|f' => sub { $self->{_options}{ifexists} = IFEXISTS_OVERWRITE },
- 'no-clobber|f' => sub { $self->{_options}{ifexists} = IFEXISTS_KEEP },
- 'quiet|q' => \$self->{_options}{quiet},
- 'jobs|j=i' => \$self->{_options}{jobs},
- 'test|t' => \$self->{_options}{test},
+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
+ },
+ 'quiet|q' => 'quiet',
+ 'jobs|j=i' => 'jobs',
+ 'test|t' => 'test'
+ },
%opts);
+ $self->{_options}{ifexists} //= IFEXISTS_OVERWRITE;
+ return $self;
}
sub run {
my $self = shift;
+
$self->abend(EX_USAGE, "two or three arguments expected")
- unless @_ == 2 || @_ == 3;
- my ($vaultname, $filespec, $localname) = @_;
+ unless $self->command_line == 2 || $self->command_line == 3;
+ my ($vaultname, $filespec, $localname) = $self->command_line;
$filespec =~ /^(?<file>.+?)(?:(?<!\\);(?<ver>\d+))?$/
or die "unexpected failure";
diff --git a/lib/App/Glacier/Command/Jobs.pm b/lib/App/Glacier/Command/Jobs.pm
index 0d405e2..c4f244c 100644
--- a/lib/App/Glacier/Command/Jobs.pm
+++ b/lib/App/Glacier/Command/Jobs.pm
@@ -1,6 +1,7 @@
package App::Glacier::Command::Jobs;
use strict;
use warnings;
+use App::Glacier::Core;
use parent qw(App::Glacier::Command);
use Carp;
use Data::Dumper;
@@ -92,20 +93,22 @@ B<strftime>(3).
=cut
-sub getopt {
- my ($self, %opts) = @_;
- return $self->SUPER::getopt('time-style=s' => sub {
- $self->set_time_style_option($_[1]);
- },
- 'long|l+' => \$self->{_options}{long},
- 'cached|c' => \$self->{_options}{cached},
- %opts);
+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 {
my $self = shift;
# my $res = $self->glacier_eval('list_jobs');
- $self->list(@_);
+ $self->list($self->command_line);
}
sub list {
diff --git a/lib/App/Glacier/Command/ListVault.pm b/lib/App/Glacier/Command/ListVault.pm
index 3533cb1..df34c38 100644
--- a/lib/App/Glacier/Command/ListVault.pm
+++ b/lib/App/Glacier/Command/ListVault.pm
@@ -2,7 +2,7 @@ package App::Glacier::Command::ListVault;
use strict;
use warnings;
-use App::Glacier::Command;
+use App::Glacier::Core;
use parent qw(App::Glacier::Command);
use App::Glacier::DateTime;
use App::Glacier::Timestamp;
@@ -136,8 +136,8 @@ B<strftime>(3).
=cut
-sub getopt {
- my ($self, %opts) = @_;
+sub new {
+ my ($class, $argref, %opts) = @_;
my %sort_vaults = (
none => undef,
name => sub {
@@ -168,38 +168,39 @@ sub getopt {
$a->{Size} <=> $b->{Size}
}
);
- $self->{_options}{sort} = 'name';
- my $rc = $self->SUPER::getopt(
- 'directory|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' },
- 'U' => sub { $self->{_options}{sort} = 'none' },
- 'human-readable|h' => \$self->{_options}{h},
- 'reverse|r' => \$self->{_options}{r},
- 'time-style=s' => sub { $self->set_time_style_option($_[1]) },
- %opts);
- return $rc unless $rc;
-
- $self->{_options}{d} = 1 if (@ARGV == 0);
+ my $self = $class->SUPER::new(
+ $argref,
+ optmap => {
+ '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',
+ 'reverse|r' => 'r',
+ 'time-style=s' => sub { $_[0]->set_time_style_option($_[2]) }
+ }, %opts);
+
+ $self->{_options}{d} = 1 if ($self->command_line == 0);
if (defined($self->{_options}{sort})) {
my $sortfun = $self->{_options}{d}
? \%sort_vaults : \%sort_archives;
- $self->abend(EX_USAGE, "unknown sort field")
+ $self->usage_error("unknown sort field")
unless exists($sortfun->{$self->{_options}{sort}});
$self->{_options}{sort} = $sortfun->{$self->{_options}{sort}};
}
+ return $self;
}
sub run {
my $self = shift;
if ($self->{_options}{d}) {
- $self->list_vaults($self->get_vault_list(@_));
+ $self->list_vaults($self->get_vault_list($self->command_line));
} else {
- $self->list_archives($self->get_vault_inventory(@_));
+ $self->list_archives($self->get_vault_inventory($self->command_line));
}
}
diff --git a/lib/App/Glacier/Command/Purge.pm b/lib/App/Glacier/Command/Purge.pm
index 6ce595b..64b5bbc 100644
--- a/lib/App/Glacier/Command/Purge.pm
+++ b/lib/App/Glacier/Command/Purge.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use App::Glacier::Command::ListVault;
use parent qw(App::Glacier::Command::ListVault);
-use App::Glacier::Command;
+use App::Glacier::Core;
=head1 NAME
@@ -42,20 +42,25 @@ B<glacier>(1).
=cut
-sub getopt {
- my ($self, %opts) = @_;
- $self->{_options}{interactive} = 1;
- $self->SUPER::getopt(
- 'interactive|i' => \$self->{_options}{interactive},
- 'force|f' => sub { $self->{_options}{interactive} = 0 },
+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
}
sub run {
my $self = shift;
- $self->abend(EX_USAGE, "exactly one argument expected") unless @_ == 1;
- my $vault_name = shift;
+ $self->abend(EX_USAGE, "exactly one argument expected")
+ unless $self->command_line == 1;
+ my $vault_name = ($self->command_line)[0];
my $dir = $self->directory($vault_name);
if ($self->{_options}{interactive}) {
unless ($self->getyn("delete all files in $vault_name")) {
diff --git a/lib/App/Glacier/Command/Put.pm b/lib/App/Glacier/Command/Put.pm
index 26e0a72..43e3724 100644
--- a/lib/App/Glacier/Command/Put.pm
+++ b/lib/App/Glacier/Command/Put.pm
@@ -1,7 +1,7 @@
package App::Glacier::Command::Put;
use strict;
use warnings;
-use App::Glacier::Command;
+use App::Glacier::Core;
use App::Glacier::DateTime;
use App::Glacier::Job::InventoryRetrieval;
use App::Glacier::Progress;
@@ -70,26 +70,30 @@ B<glacier>(1).
=cut
-sub getopt {
- my ($self, %opts) = @_;
- return $self->SUPER::getopt('jobs|j=i' => \$self->{_options}{jobs},
- 'quiet|q' => \$self->{_options}{quiet},
- 'rename|r' => \$self->{_options}{rename},
- %opts);
+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;
if ($self->{_options}{rename}) {
$self->abend(EX_USAGE, "exactly three arguments expected")
- unless @_ == 3;
- my ($vaultname, $localname, $remotename) = @_;
+ unless $self->command_line == 3;
+ my ($vaultname, $localname, $remotename) = $self->command_line;
$self->_upload($vaultname, $localname, $remotename);
} else {
- $self->abend(EX_USAGE, "too few arguments") if @_ < 2;
- my $vaultname = shift;
+ my @argv = $self->command_line;
+ $self->abend(EX_USAGE, "too few arguments") if @argv < 2;
+ my $vaultname = shift @argv;
my @failed_uploads;
- foreach my $filename (@_) {
+ foreach my $filename (@argv) {
eval {
$self->_upload($vaultname, $filename);
};
@@ -102,7 +106,7 @@ sub run {
}
}
if (@failed_uploads) {
- if (@failed_uploads == @_) {
+ if (@failed_uploads == @argv) {
exit(EX_FAILURE);
} else {
$self->error("the following files failed to upload: "
diff --git a/lib/App/Glacier/Command/Sync.pm b/lib/App/Glacier/Command/Sync.pm
index a82b71a..1a1fcaf 100644
--- a/lib/App/Glacier/Command/Sync.pm
+++ b/lib/App/Glacier/Command/Sync.pm
@@ -2,7 +2,7 @@ package App::Glacier::Command::Sync;
use strict;
use warnings;
-use App::Glacier::Command;
+use App::Glacier::Core;
use parent qw(App::Glacier::Command);
use App::Glacier::DateTime;
use App::Glacier::Timestamp;
@@ -23,7 +23,7 @@ I<VAULT>
=head1 DESCRIPTION
-Retrieves inventory for I<VAULT> and incorporates date into the local
+Retrieves inventory for I<VAULT> and incorporates it into the local
directory. Use this command if the local directory went out of sync
or was otherwise clobbered.
@@ -48,17 +48,22 @@ B<glacier>(1).
=cut
-sub getopt {
- my ($self, %opts) = @_;
- return $self->SUPER::getopt('force|f' => \$self->{_options}{force},
- 'delete|d' => \$self->{_options}{delete},
- %opts);
+sub new {
+ my ($class, $argref, %opts) = @_;
+ $class->SUPER::new(
+ $argref,
+ optmap => {
+ 'force|f' => 'force',
+ 'delete|d' => 'delete'
+ },
+ %opts);
}
sub run {
my $self = shift;
- $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
- unless ($self->sync(shift, %{$self->{_options}})) {
+ $self->abend(EX_USAGE, "one argument expected")
+ unless $self->command_line == 1;
+ unless ($self->sync(($self->command_line)[0], %{$self->{_options}})) {
exit(EX_TEMPFAIL);
}
}
diff --git a/lib/App/Glacier/Config.pm b/lib/App/Glacier/Config.pm
index 6cacf9c..c0899e9 100644
--- a/lib/App/Glacier/Config.pm
+++ b/lib/App/Glacier/Config.pm
@@ -211,13 +211,8 @@ sub new {
my $v;
my $err;
- if (defined($v = delete $_{debug})) {
- $self->{debug} = $v;
- }
-
- if (defined($v = delete $_{ci})) {
- $self->{ci} = $v;
- }
+ $self->{debug} = delete $_{debug} // 0;
+ $self->{ci} = delete $_{ci} // 0;
if (defined($v = delete $_{parameters})) {
if (ref($v) eq 'HASH') {
diff --git a/lib/App/Glacier/Core.pm b/lib/App/Glacier/Core.pm
new file mode 100644
index 0000000..9ac2494
--- /dev/null
+++ b/lib/App/Glacier/Core.pm
@@ -0,0 +1,232 @@
+package App::Glacier::Core;
+use strict;
+use warnings;
+use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
+use Pod::Man;
+use Pod::Usage;
+use Pod::Find qw(pod_where);
+use File::Basename;
+use Carp;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(usage_error
+ pod_usage_msg
+ EX_OK
+ EX_FAILURE
+ EX_USAGE
+ EX_DATAERR
+ EX_NOINPUT
+ EX_NOUSER
+ EX_NOHOST
+ EX_UNAVAILABLE
+ EX_SOFTWARE
+ EX_OSERR
+ EX_OSFILE
+ EX_CANTCREAT
+ EX_IOERR
+ EX_TEMPFAIL
+ EX_PROTOCOL
+ EX_NOPERM
+ EX_CONFIG);
+
+use constant {
+ EX_OK => 0,
+ EX_FAILURE => 1,
+ EX_USAGE => 64,
+ EX_DATAERR => 65,
+ EX_NOINPUT => 66,
+ EX_NOUSER => 67,
+ EX_NOHOST => 68,
+ EX_UNAVAILABLE => 69,
+ EX_SOFTWARE => 70,
+ EX_OSERR => 71,
+ EX_OSFILE => 72,
+ EX_CANTCREAT => 73,
+ EX_IOERR => 74,
+ EX_TEMPFAIL => 75,
+ EX_PROTOCOL => 76,
+ EX_NOPERM => 77,
+ EX_CONFIG => 78
+};
+
+
+sub new {
+ my ($class, $argref) = (shift, shift);
+ my $self = bless {
+ _debug => 0,
+ _dry_run => 0,
+ _progname => basename($0)
+ }, $class;
+
+ $self->{_argref} = $argref // \@ARGV;
+ my %opts;
+ local %_ = @_;
+
+ if (my $optmap = delete $_{optmap}) {
+ foreach my $k (keys %{$optmap}) {
+ if (ref($optmap->{$k}) eq 'CODE') {
+ $opts{$k} = sub { &{$optmap->{$k}}($self, @_ ) }
+ } elsif (ref($optmap->{$k})) {
+ $opts{$k} = $optmap->{$k};
+ } else {
+ $opts{$k} = \$self->{_options}{$optmap->{$k}}
+ }
+ }
+ }
+ croak "unrecognized parameters" if keys(%_);
+
+ $opts{'shorthelp|?'} = sub {
+ pod2usage(-message => $self->pod_usage_msg,
+ -input => pod_where({-inc => 1}, ref($self)),
+ -exitstatus => EX_OK)
+ };
+ $opts{help} = sub {
+ pod2usage(-exitstatus => EX_OK,
+ -verbose => 2,
+ -input => pod_where({-inc => 1}, ref($self)))
+ };
+ $opts{usage} = sub {
+ pod2usage(-exitstatus => EX_OK,
+ -verbose => 0,
+ -input => pod_where({-inc => 1}, ref($self)))
+ };
+ $opts{'debug|D'} = sub { $self->{_debug}++ };
+ $opts{'dry-run|n'} = sub { $self->{_debug}++; $self->{_dry_run} = 1 };
+ $opts{'program-name=s'} = sub { $self->{_progname} = $_[1] };
+
+ GetOptionsFromArray($self->{_argref}, %opts);
+
+ return $self;
+}
+
+sub dry_run { shift->{_dry_run} }
+sub argv { shift->{_argref} }
+sub command_line { @{shift->{_argref}} }
+
+sub progname {
+ my $self = shift;
+ if (my $v = shift) {
+ croak "too many arguments" if @_;
+ $self->{_progname} = $v;
+ }
+ $self->{_progname};
+}
+
+sub debug {
+ my ($self, $l, @msg) = @_;
+ if ($self->{_debug} >= $l) {
+ print STDERR "$self->{_prog