diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2018-03-06 00:23:34 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2018-03-06 00:57:23 +0200 |
commit | 86fb141c932c2305dbb096db36c929f4931f0c04 (patch) | |
tree | 64a65ac2b268c5ed83799c9cdcf9deda50baa128 /lib | |
parent | f25b98d6b4080b9caad8ca586fc20483aac68a3b (diff) | |
download | glacier-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.pm | 63 | ||||
-rw-r--r-- | lib/App/Glacier/Command.pm | 190 | ||||
-rw-r--r-- | lib/App/Glacier/Command/CreateVault.pm | 7 | ||||
-rw-r--r-- | lib/App/Glacier/Command/DeleteFile.pm | 11 | ||||
-rw-r--r-- | lib/App/Glacier/Command/DeleteVault.pm | 9 | ||||
-rw-r--r-- | lib/App/Glacier/Command/Get.pm | 42 | ||||
-rw-r--r-- | lib/App/Glacier/Command/Jobs.pm | 21 | ||||
-rw-r--r-- | lib/App/Glacier/Command/ListVault.pm | 43 | ||||
-rw-r--r-- | lib/App/Glacier/Command/Purge.pm | 23 | ||||
-rw-r--r-- | lib/App/Glacier/Command/Put.pm | 30 | ||||
-rw-r--r-- | lib/App/Glacier/Command/Sync.pm | 23 | ||||
-rw-r--r-- | lib/App/Glacier/Config.pm | 9 | ||||
-rw-r--r-- | lib/App/Glacier/Core.pm | 232 | ||||
-rw-r--r-- | lib/App/Glacier/Job.pm | 2 | ||||
-rw-r--r-- | lib/App/Glacier/Job/FileRetrieval.pm | 2 |
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 |