From 331abf07d47b10abede1624a1aee52d1f0a70da0 Mon Sep 17 00:00:00 2001 From: Flavio Poletti Date: Mon, 1 Sep 2008 03:24:57 +0200 Subject: [PATCH] Added interactive mode with Term::ShellUI. Fantastic! --- s3 | 197 +++++++++++++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 136 insertions(+), 61 deletions(-) diff --git a/s3 b/s3 index c640dc0..74daf72 100755 --- a/s3 +++ b/s3 @@ -24,6 +24,7 @@ use Config::Tiny; my %config = ( configfile => "$ENV{HOME}/.aws", + histfile => "$ENV{HOME}/.s3_history", 'load-config' => 1, data => '', ); @@ -31,6 +32,7 @@ GetOptions( \%config, qw( usage! help! man! version! + interactive|i! id=s secret=s delimiter=s max-keys=s marker=s dir! ls! l! meta|m=s@ header|h=s@ acl=s data=s @@ -53,20 +55,6 @@ if ($config{'load-config'} && -r $config{configfile}) { } } ## end if ($config{'load-config'... -my $target = 'Object'; -my $command = lc shift @ARGV; -if ($command eq 'bucket') { - $target = 'Bucket'; - $command = lc shift @ARGV; -} - -$command =~ s/^_+//; - -DEBUG "command: $command"; - -my $sub = Operations->can($command) - or LOGDIE "unknown command '$command'"; - my $s3 = Net::Amazon::S3->new( { aws_access_key_id => $config{id}, @@ -75,7 +63,89 @@ my $s3 = Net::Amazon::S3->new( } ); -$sub->($s3, \%config, @ARGV); +if ($config{interactive}) { + get_logger()->level($INFO); + require Term::ShellUI; + + my %commands = ( + list => { desc => 'list buckets/keys' }, + add => { desc => 'add bucket/key, optionally from file' }, + create => { desc => 'create bucket' }, + copy => { desc => 'copy one key onto another' }, + get => { desc => 'retrieve a key' }, + show => { desc => 'show metadata/headers for key' }, + meta => { desc => 'show/set metadata for key' }, + acl => { desc => 'show/set acl for bucket/key' }, + 'delete' => { desc => 'delete bucket/key' }, + locate => { desc => 'location constraint for bucket' }, + ls => { desc => 'list a-la system ls' }, + dir => { desc => 'list a-la system ls -l' }, + cp => { desc => 'DWIM copy a-la system cp' }, + mv => { desc => 'DWIM move/rename a-la system mv' }, + cat => { desc => 'retrieve keys/files and print out' }, + rm => { desc => 'DWIM deletion a-la system rm' }, + ); + + for my $command ( keys %commands ) { + $commands{$command}{proc} = sub { + launch_command($s3, \%config, $command, @_); + }; + } + + my $term = Term::ShellUI->new( + commands => { + %commands, + help => { + desc => 'print helpful stuff about this program', + args => sub { shift->help_args(undef, @_); }, + method => sub { shift->help_call(undef, @_); } + }, + "h" => { alias => "help", exclude_from_completion=>1}, + "?" => { alias => "help", exclude_from_completion=>1}, + debug => { + proc => sub { + my ($debug) = @_; + get_logger()->level($debug ? $DEBUG : $INFO); + }, + }, + quit => {method => sub { $_[0]->exit_requested(1); },}, + exit => { alias => 'quit', exclude_from_completion => 1 }, + q => { alias => 'quit', exclude_from_completion => 1 }, + }, + history_file => $config{histfile}, + ); + INFO 'Using ' . $term->{term}->ReadLine . "\n"; + $term->run(); +} ## end if ($config{interactive... +else { + launch_command($s3, \%config, @ARGV); +} + +sub launch_command { + my ($s3, $ext_config, $command, @args) = @_; + + $command =~ s/^_+//; + DEBUG "command: $command"; + + my $sub = Operations->can($command) + or LOGDIE "unknown command '$command'"; + + my %config; + { + local @ARGV = @args; + GetOptions( + \%config, + qw( + delimiter=s max-keys=s marker=s dir! ls! l! + meta|m=s@ header|h=s@ acl=s data=s + clear! add=s@ del=s@ + ) + ); + @args = @ARGV; + } + + $sub->($s3, {%$ext_config, %config}, @args); +} ## end sub launch_command sub s3path_split { my ($s3path) = @_; @@ -208,10 +278,10 @@ sub list { $name = _canonical($bucket, $name); $date =~ s/T/ /; - if ($config{l}) { # a-la ls -l + if ($config->{l}) { # a-la ls -l print {*STDOUT} "---------- 1 $owner $owner $size $date $name\n"; } - else { # simply the name + else { # simply the name print {*STDOUT} $name, "\n"; } } ## end for my $file (@{$response... @@ -393,54 +463,59 @@ sub _cp_or_mv { } ## end else [ if (main::is_s3path($dst... return; -} ## end sub cp +} ## end sub _cp_or_mv sub cp { - return _cp_or_mv({ - r2r => \©, - l2r => sub { - my ($s3, $config, $src, $dst) = @_; - add($s3, $config, $dst, $src); # swap dst and src for add! + return _cp_or_mv( + { + r2r => \©, + l2r => sub { + my ($s3, $config, $src, $dst) = @_; + add($s3, $config, $dst, $src); # swap dst and src for add! + }, + r2l => \&get, + l2l => sub { + my ($s3, $config, $src, $dst); + main::cp_local($src, $dst); + }, }, - r2l => \&get, - l2l => sub { - my ($s3, $config, $src, $dst); - main::cp_local($src, $dst); - }, - }, @_); -} + @_ + ); +} ## end sub cp sub mv { - return _cp_or_mv({ - r2r => sub { - copy(@_); - _delete(@_); - }, - l2r => sub { - my ($s3, $config, $src, $dst) = @_; - add($s3, $config, $dst, $src); # swap dst and src for add! - unlink $src or LOGDIE "could not delete '$src': $OS_ERROR"; - return; + return _cp_or_mv( + { + r2r => sub { + copy(@_); + _delete(@_); + }, + l2r => sub { + my ($s3, $config, $src, $dst) = @_; + add($s3, $config, $dst, $src); # swap dst and src for add! + unlink $src or LOGDIE "could not delete '$src': $OS_ERROR"; + return; + }, + r2l => sub { + get(@_); + _delete(@_); + }, + l2l => sub { + my ($s3, $config, $src, $dst) = @_; + + # Try a simple rename, if possible + rename($src, $dst) and return; + + # Fall back to copy-and-delete + main::cp_local($src, $dst); + unlink $src or LOGDIE "could not delete '$src': $OS_ERROR"; + + return; + }, }, - r2l => sub { - get(@_); - _delete(@_); - }, - l2l => sub { - my ($s3, $config, $src, $dst) = @_; - - # Try a simple rename, if possible - rename($src, $dst) and return; - - # Fall back to copy-and-delete - main::cp_local($src, $dst); - unlink $src or LOGDIE "could not delete '$src': $OS_ERROR"; - - return; - }, - }, @_); -} - + @_ + ); +} ## end sub mv sub cat { my ($s3, $config, @paths) = @_; @@ -596,10 +671,10 @@ sub _acl_noACL { LOGDIE "could not get ACL for '$s3path': ", $s3->err() unless $acl; - + print {*STDOUT} $acl; return; -} +} ## end sub _acl_noACL sub _delete { my ($s3, $config, $s3path) = @_; -- 2.11.4.GIT