File Coverage

blib/lib/Yars/Command/yars_fast_balance.pm
Criterion Covered Total %
statement 41 126 32.5
branch 0 34 0.0
condition 0 5 0.0
subroutine 14 25 56.0
pod 0 6 0.0
total 55 196 28.0


line stmt bran cond sub pod time code
1             package Yars::Command::yars_fast_balance;
2              
3             # PODNAME: yars_fast_balance
4             # ABSTRACT: Fix all files
5             our $VERSION = '1.30'; # VERSION
6              
7              
8 2     2   2931 use strict;
  2         7  
  2         72  
9 2     2   14 use warnings;
  2         6  
  2         62  
10 2     2   51 use 5.010;
  2         14  
11 2     2   425 use Yars::Client;
  2         8  
  2         27  
12 2     2   81 use Log::Log4perl ();
  2         6  
  2         83  
13 2     2   406 use Clustericious::Log::CommandLine ':all', ':loginit' => { level => $Log::Log4perl::INFO };
  2         1756  
  2         24  
14 2     2   2888 use Clustericious::Log;
  2         5  
  2         17  
15 2     2   1844 use Clustericious::Config;
  2         4  
  2         59  
16 2     2   372 use Hash::MoreUtils qw/safe_reverse/;
  2         1185  
  2         117  
17 2     2   379 use File::Find::Rule;
  2         6300  
  2         21  
18 2     2   114 use Fcntl qw(:DEFAULT :flock);
  2         7  
  2         840  
19 2     2   14 use File::Basename qw/dirname/;
  2         6  
  2         107  
20 2     2   13 use Getopt::Long qw( GetOptions );
  2         4  
  2         17  
21 2     2   220 use Pod::Usage qw( pod2usage );
  2         5  
  2         2321  
22              
23             our $conf;
24             our $yc;
25              
26             sub _is_empty_dir {
27             # http://www.perlmonks.org/?node_id=617410
28             #my ($shortname, $path, $fullname) = @_;
29 0     0     my $fullname = $_[2];
30 0           my $dh;
31 0 0         opendir($dh, $fullname) || return;
32 0           my $count = scalar(grep{!/^\.\.?$/} readdir $dh);
  0            
33 0           closedir $dh;
34 0           return($count==0);
35             }
36              
37             sub cleanup_subdir {
38 0     0 0   my ($dir) = @_;
39 0           while (_is_empty_dir(undef,undef,$dir) ) {
40 0 0         last unless $dir =~ m{/[0-9a-f]{2}$};
41 0 0         rmdir $dir or do { WARN "cannot rmdir $dir : $!"; last; };
  0            
  0            
42 0           $dir =~ s{/[^/]+$}{};
43             }
44             }
45              
46             sub cleanup_directory {
47 0     0 0   my $dir = shift;
48 0           DEBUG "Looking for empty directories in $dir";
49 0           my @found = File::Find::Rule->new->directory->exec(\&_is_empty_dir)->in($dir);
50 0 0         return unless @found;
51 0           for my $empty (@found) { ### Cleaning up $dir ... [%]
52 0           TRACE "Cleaning up $empty";
53 0           cleanup_subdir($empty);
54             }
55             }
56              
57             sub _lock {
58 0     0     my $filename = shift;
59 0           my $fh;
60 0 0         open $fh, ">> $filename" or do {
61 0           TRACE "Cannot lock $filename : $!";
62 0           return;
63             };
64 0 0         flock( $fh, LOCK_EX | LOCK_NB ) or do {
65 0           WARN "cannot flock $filename";
66 0           close $fh;
67 0           return;
68             };
69 0           return $fh;
70             }
71              
72             sub _unlock {
73 0     0     my $fh = shift;
74 0           flock $fh, LOCK_UN;
75             }
76              
77             sub upload_file {
78 0     0 0   my $filename = shift;
79 0           TRACE "Moving $filename";
80 0   0       $yc //= Yars::Client->new;
81 0 0         $yc->upload('--nostash', 1, $filename) or do {
82 0           WARN "Could not upload $filename : ".$yc->errorstring;
83 0           return;
84             };
85 0 0         unlink $filename or do {
86 0           WARN "Could not unlink $filename : $!";
87 0           return;
88             };
89 0           cleanup_subdir(dirname($filename));
90             }
91              
92             sub upload_directory {
93 0     0 0   my $dir = shift;
94 0           my @found = File::Find::Rule->new->file->in($dir);
95 0 0         return unless @found;
96 0           for my $file (@found) { ### Uploading files from $dir ... [%]
97 0 0         my $fh = _lock($file) or next;
98 0           upload_file($file);
99 0           _unlock($fh);
100             }
101             }
102              
103             sub check_disk {
104 0     0 0   my $root = shift;
105 0           my @this = grep { $_->{root} eq $root } map @{ $_->{disks} }, $conf->servers;
  0            
  0            
106 0 0         LOGDIE "Found ".@this." matches for $root" unless @this==1;
107 0           my $disk = $this[0];
108 0           my @buckets = @{ $disk->{buckets} };
  0            
109 0           my @wrong;
110 0           for my $dir (glob "$root/*") {
111 0           $dir =~ s/^$root\///;
112 0 0         next unless $dir =~ /^[0-9a-f]{2}$/;
113 0 0         next if grep { $dir =~ /^$_/i } @buckets;
  0            
114 0           push @wrong, $dir;
115             }
116 0 0         if (@wrong==0) {
117 0           INFO "Disk $root : ok";
118 0           return;
119             }
120 0           INFO "Disk $root : ".@wrong." stashed directories";
121 0           for my $dir (@wrong) {
122 0           cleanup_directory("$root/$dir");
123 0           upload_directory("$root/$dir");
124             }
125             }
126              
127             sub main {
128 0     0 0   my $class = shift;
129 0           local @ARGV = @_;
130             GetOptions(
131 0     0     'help|h' => sub { pod2usage({ -verbose => 2}) },
132             'version' => sub {
133 0   0 0     say 'Yars version ', ($Yars::Command::yars_fast_balance::VERSION // 'dev');
134 0           exit 1;
135             },
136 0 0         ) || pod2usage(1);
137 0           $conf = Clustericious::Config->new("Yars");
138 0           my @disks = map $_->{root}, map @{ $_->{disks} }, $conf->servers;
  0            
139 0 0         LOGDIE "No disks" unless @disks;
140 0           for my $disk (@disks) {
141 0 0         next unless -d $disk;
142 0           check_disk($disk);
143             }
144             }
145              
146             1;
147              
148             __END__
149              
150             =pod
151              
152             =head1 NAME
153              
154             Yars::Command::yars_fast_balance - code for yars_fast_balance
155              
156             =head1 DESCRIPTION
157              
158             This module contains the machinery for the command line program L<yars_fast_balance>
159              
160             =head1 SEE ALSO
161              
162             L<yars_disk_scan>
163              
164             =cut