#!/usr/bin/perl
#
#
use strict;
use Getopt::Std;
use LWP::Protocol::https;   # ensure using https!
use Net::Amazon::S3;

my $VERSION = '2.8.13';

my %opts;
getopts('DFdhlqvb:c:i:d:P:',\%opts);

$opts{h} and help_exit();

my $conf = read_config($opts{c} || '/etc/benno-s3-admin/benno-s3-admin.conf');

$conf->{bucket}       = $opts{b} if $opts{b};
$conf->{bucket_list}  = $opts{l} if $opts{l};
$conf->{del_key}      = $opts{d} if $opts{d};
$conf->{del_keypfx}   = $opts{D} if $opts{D};
$conf->{force_pfx}    = $opts{F} if $opts{F};
$conf->{keyid}        = $opts{i} if $opts{i};
$conf->{prefix}       = $opts{P} if $opts{P};
$conf->{quiet}        = $opts{q} if $opts{q};
$conf->{verbose}      = $opts{v} if $opts{v};

$conf->{_S3} = new S3($conf);

$conf->{del_key}                && del_key($conf); 
$conf->{del_keypfx}             && del_keyprefix($conf); 
$conf->{bucket}                 && print_bucketfiles($conf); 
$conf->{bucket_list}            && print_buckets($conf); 

print STDERR "Missing command argument.\n";
help_exit();


### SUBS #######################################################################

### del_key
sub del_key
{
    my ($conf,$keyid) = @_;
    my $S3 = $conf->{_S3};

    $keyid = $conf->{keyid} unless $keyid;
    my $bucket = $S3->bucket($conf->{bucket});
    $bucket->delete_key($keyid) or die $S3->err . ": " . $S3->errstr;

    exit 0;
}


### del_keyprefix
sub del_keyprefix
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};

    my $prefix = 'NOPREFIX';
    $prefix = $conf->{prefix} or die "ERROR. Prefix not given.\n"; 
    if ($prefix !~ /benno\/data\/repo\/\S{4,}/) {
        print "WARN Delete prefix starts not with \"benno/data/repo/..../\"\n";
        print "Override with switch \"-F\"\n" unless $conf->{force_pfx};
        exit 1 unless $conf->{force_pfx};
    }

    my $bucket = $S3->bucket($conf->{bucket});
    my $response = _get_objeclist($S3,$bucket,$prefix);

    my $keycount = @{$response->{keys}};
    print "Delete $keycount objects from \"[$conf->{bucket}]$prefix\"\n";

    my $stats = new Stats;
    foreach my $keyobj (@{$response->{keys}}) {
        $stats->add($keyobj);
        print "Delete #".$stats->get_count." [$conf->{bucket}]$keyobj->{key}\n" if $conf->{verbose};
        $bucket->delete_key($keyobj->{key})
                or die $S3->err . ": " . $S3->errstr;
    }

    unless ($conf->{quiet}) {
        print $stats->get_size, " in ",$stats->get_count," files deleted.\n";
    }

    exit 0;
}


### print_buckets
sub print_buckets
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};
    foreach my $bucket (@{$S3->buckets->{buckets}}) {
        print $bucket->bucket,"\n";
    }

    exit 0;
}


### print_bucketfiles
sub print_bucketfiles
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};

    my $bucket = $S3->bucket($conf->{bucket});
    my $response = _get_objeclist($S3,$bucket,$conf->{prefix});

    my $stats = new Stats();
    foreach my $key (@{$response->{keys}}) {
        $stats->add($key);

        print "$key->{key}\n";
        print "  Size:     $key->{size} bytes\n" unless ($conf->{quiet});
        print "  Modified: $key->{last_modified}\n" if ($conf->{verbose});
    }

    print "\n";

    unless ($conf->{quiet}) {
        print $stats->get_size, " in ",$stats->get_count," files.\n";
    }

    exit 0;
}

### help_exit
sub help_exit
{
    print "Usage: benno-s3-admin [-D] [-c <configfile>]\n";
    print "  -c <configfile>    config file (/etc/benono-s3-admin/benno-s3-admin.conf)\n";
    print "  -l                 list buckets\n";
    print "  -q                 quiet mode\n";
    print "  -F                 force short prefix\n";
    print "  -v                 verbose mode\n";
    print "\n";
    print " List operations\n";
    print "  -b <bucket> <args>\n";
    print "    ... -l           list objects in bucket\n";
    print "    ... -P <prefix>  list objects with prefix\n";
    print "\n";
    print " Bucket operations\n";
    print "  -b <bucket> <args>\n";
    print "    ... -i <keyid>  -d delete key with given id\n";
    print "    ... -P <prefix> -D delete keys with given prefix\n";
    print "\n";
    print "\n";
    exit 1;
}

### read_config
#
# read configuration from file
#
sub read_config
{
  my $configfile = shift;
  my $config = {};
  # _very_ simple config file parser
  #
  # Config format:   var = val
  #
  open CONF, "$configfile" or die "Cannot open config file $configfile. $!\n";
  foreach my $line (<CONF>) {
      next if $line =~ /^$/;
      next if $line =~ /^#/;
      chomp $line;
      my ($var,$val) = split(/=/, $line,2);
      # strip ws
      $var =~ s/\s//g;
      $val =~ s/^\s+//g;
      $val =~ s/\s+$//g;
      $config->{$var} = $val;
  }
  close CONF;
  return $config;
}


sub _get_objeclist
{
    my ($S3,$bucket,$prefix) = @_;
    my $response = $bucket->list_all({ prefix => $prefix})
            or die $S3->err . ": " . $S3->errstr;

    return $response;
}



### EOP ###
1;


package Stats;

sub new
{
    my $class = shift;
    my $self = {
        counter => 0,
        size    => 0,
    };
    return bless $self, $class;
}

sub add
{
    my ($self,$keyobj) = @_;
    $self->{counter}++;
    $self->{size} += $keyobj->{size};
}

sub get_count
{
    return $_[0]->{counter};
}

sub get_size
{
    my ($self,$value_only) = @_;

    my $size = $self->{size};
    return $size if $value_only;


    my $unit = $size > 1024**9 ? sprintf("%.2f TB",$size / 1024**9)
             : $size > 1024**6 ? sprintf("%.2f GB",$size / 1024**6)
             : $size > 1024**3 ? sprintf("%.2f MB",$size / 1024**3)
             : $size > 1024    ? sprintf("%.2f kB",$size / 1024)
             :                   "$size bytes"
             ;

    return $unit;
}
### EOP ###
1;


package S3;
use parent 'Net::Amazon::S3';

sub new
{
    my $class = shift;
    my ($conf) = @_;

    my $self = Net::Amazon::S3->new({
                  aws_access_key_id     => $conf->{authkeyid},
                  aws_secret_access_key => $conf->{authsecret},
                  host                  => $conf->{host},
               });

    bless $self, $class;
    return $self;
}


sub bucket
{
    my ($self,$bucket) = @_;

    return $self->SUPER::bucket($bucket);
}



### EOP ###
1;

