The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

=head1 NAME

yars_fast_balance

=head1 SYNOPSIS

yars_fast_balance
yars_fast_balance --info

=head1 DESCRIPTION

Attempt to fix all files on this server.

Don't run this unless all disks and
servers are fully operational.

If they are not, then failures will be
expensive, and things won't get balanced.

=cut

use Yars::Client;
use Log::Log4perl qw(:levels);
use Log::Log4perl::CommandLine ':all', ':loginit' => { level => $INFO };
use Clustericious::Log;
use Clustericious::Config;
use Hash::MoreUtils qw/safe_reverse/;
use File::Find::Rule;
use IO::Dir;
use Fcntl qw(:DEFAULT :flock);
use Data::Dumper;
use File::Basename qw/dirname/;
use Smart::Comments;

use strict;
use warnings;

our $conf;
our $yc = Yars::Client->new();

&main;

sub _is_empty_dir {
  # http://www.perlmonks.org/?node_id=617410
  my ($shortname, $path, $fullname) = @_;
  my $dh = IO::Dir->new($fullname) or return;
  my $count = scalar(grep{!/^\.\.?$/} $dh->read());
  $dh->close();
  return($count==0);
}

sub cleanup_subdir {
    my ($dir) = @_;
    while (_is_empty_dir(undef,undef,$dir) ) {
        last unless $dir =~ m{/[0-9a-f]{2}$};
        rmdir $dir or do { WARN "cannot rmdir $dir : $!"; last; };
        $dir =~ s{/[^/]+$}{};
    }
}

sub cleanup_directory {
    my $dir = shift;
    DEBUG "Looking for empty directories in $dir";
    my @found = File::Find::Rule->new->directory->exec(\&_is_empty_dir)->in($dir);
    return unless @found;
    for my $empty (@found) {  ### Cleaning up $dir ... [%]
        TRACE "Cleaning up $empty";
        cleanup_subdir($empty);
    }
}

sub _lock {
    my $filename = shift;
    my $fh;
    open $fh, ">> $filename" or do {
        TRACE "Cannot lock $filename : $!";
        return;
    };
    flock( $fh, LOCK_EX | LOCK_NB ) or do {
        WARN "cannot flock $filename";
        close $fh;
        return;
    };
    return $fh;
}

sub _unlock {
    my $fh = shift;
    flock $fh, LOCK_UN;
}

sub upload_file {
    my $filename = shift;
    TRACE "Moving $filename";
    $yc->upload('--nostash', 1, $filename) or do {
        WARN "Could not upload $filename : ".$yc->errorstring;
        return;
    };
    unlink $filename or do {
        WARN "Could not unlink $filename : $!";
        return;
    };
    cleanup_subdir(dirname($filename));
}

sub upload_directory {
    my $dir = shift;
    my @found = File::Find::Rule->new->file->in($dir);
    return unless @found;
    for my $file (@found) {  ### Uploading files from $dir ... [%]
        my $fh = _lock($file) or next;
        upload_file($file);
        _unlock($fh);
    }
}

sub check_disk {
    my $root = shift;
    my @this = grep { $_->{root} eq $root } map @{ $_->{disks} }, $conf->servers;
    LOGDIE "Found ".@this." matches for $root" unless @this==1;
    my $disk = $this[0];
    my @buckets = @{ $disk->{buckets} };
    my @wrong;
    for my $dir (glob "$root/*") {
        $dir =~ s/^$root\///;
        next unless $dir =~ /^[0-9a-f]{2}$/;
        next if grep { $dir =~ /^$_/i } @buckets;
        push @wrong, $dir;
    }
    if (@wrong==0) {
        INFO "Disk $root : ok";
        return;
    }
    INFO "Disk $root : ".@wrong." stashed directories";
    for my $dir (@wrong) {
        cleanup_directory("$root/$dir");
        upload_directory("$root/$dir");
    }
}

sub main {
    $conf = Clustericious::Config->new("Yars");
    my @disks = @ARGV;
    @disks = map $_->{root}, map @{ $_->{disks} }, $conf->servers;
    LOGDIE "No disks" unless @disks;
    for my $disk (@disks) {
       next unless -d $disk;
       check_disk($disk);
    }
}