File Coverage

blib/lib/Mogstored/FIDStatter.pm
Criterion Covered Total %
statement 66 69 95.6
branch 20 26 76.9
condition 4 7 57.1
subroutine 14 16 87.5
pod 0 8 0.0
total 104 126 82.5


line stmt bran cond sub pod time code
1             package Mogstored::FIDStatter;
2 1     1   18242 use strict;
  1         2  
  1         35  
3 1     1   4 use warnings;
  1         2  
  1         26  
4 1     1   4 use Carp qw(croak);
  1         1  
  1         837  
5              
6             # on_fid => sub { my ($fidid, $size) = @_; ... }
7             # t_stat => sub { my $fid = shift }
8             sub new {
9 3     3 0 5214 my ($class, %opts) = @_;
10 3         9 my $self = bless {}, $class;
11 3         10 foreach (qw(dir from to on_fid t_stat)) {
12 15         34 $self->{$_} = delete $opts{$_};
13             }
14 3 50       11 croak("unknown opts") if %opts;
15 3   50 0   10 $self->{on_fid} ||= sub {};
  0         0  
16 3   50 0   9 $self->{t_stat} ||= sub {};
  0         0  
17 3         9 return $self;
18             }
19              
20             sub run {
21 4     4 0 50108 my $self = shift;
22              
23             # min/max dirs we could possibly care about format: "n/nnn/nnn/"
24 4         17 my $min_dir = dir($self->{from});
25 4         9 my $max_dir = dir($self->{to});
26              
27             # our start/end fid ranges, zero-padded to 25 or so digits, to be
28             # string-comparable, avoiding integer math (this might be a 32-bit
29             # machine, with a 64-bit mogilefsd/clients)
30 4         15 my $min_zpad = zeropad($self->{from});
31 4         8 my $max_zpad = zeropad($self->{to});
32              
33             my $dir_in_range = sub {
34 15     15   18 my $dir = shift; # "n/[nnn/[nnnn/]]"
35 15 100       21 return 0 if max_subdir($dir) lt $min_dir;
36 13 100       19 return 0 if min_subdir($dir) gt $max_dir;
37 12         48 return 1;
38 4         19 };
39              
40             my $file_in_range = sub {
41 508     508   594 my $fid = zeropad(shift);
42 508   66     1916 return $fid ge $min_zpad && $fid le $max_zpad;
43 4         11 };
44              
45             foreach_dentry($self->{dir}, qr/^\d$/, sub {
46 6     6   34 my ($bdir, $dir) = @_;
47 6 100       11 return unless $dir_in_range->("$bdir/");
48              
49             foreach_dentry($dir, qr/^\d{3}$/, sub {
50 3         5 my ($mdir, $dir) = @_;
51 3 50       6 return unless $dir_in_range->("$bdir/$mdir/");
52              
53             foreach_dentry($dir, qr/^\d{3}$/, sub {
54 6         78 my ($tdir, $dir) = @_;
55 6 50       20 return unless $dir_in_range->("$bdir/$mdir/$tdir/");
56              
57             foreach_dentry($dir, qr/^\d+\.fid$/, sub {
58 508         2662 my ($file, $fullfile) = @_;
59 508         1608 my ($fid) = ($file =~ /^0*(\d+)\.fid$/);
60 508 100       623 return unless $file_in_range->($fid);
61              
62 507         810 $self->{t_stat}->($fid);
63 507         7108 my $size = (stat($fullfile))[9];
64 507 50       1384 $self->{on_fid}->($fid, $size) if $size;
65 6         59 });
66 3         22 });
67 3         24 });
68 4         37 });
69             }
70              
71             sub zeropad {
72 516     516 0 415 my $fid = shift;
73 516         883 return "0"x(25-length($fid)) . $fid;
74             }
75              
76             sub foreach_dentry {
77 16     16 0 23 my ($dir, $re, $code) = @_;
78 16 50       349 opendir(my $dh, $dir) or die "Failed to open $dir: $!";
79 16         922 $code->($_, "$dir/$_") foreach sort grep { /$re/ } readdir($dh);
  555         1476  
80             }
81              
82             # returns directory that a fid will be in
83             # $fid may or may not have leading zeroes.
84             sub dir {
85 8     8 0 9 my $fid = shift;
86 8         28 $fid =~ s!^0*!!;
87 8 100       28 $fid = "0"x(10-length($fid)) . $fid if length($fid) < 10;
88 8         27 my ($b, $mmm, $ttt) = $fid =~ m{^(\d)(\d{3})(\d{3})};
89 8         21 return "$b/$mmm/$ttt/";
90             }
91              
92 15     15 0 29 sub max_subdir { pad_dir($_[0], "999"); }
93 13     13 0 89 sub min_subdir { pad_dir($_[0], "000"); }
94              
95             sub pad_dir {
96 28     28 0 31 my ($dir, $pad) = @_;
97 28 100       41 if (length($dir) == 2) { return "$dir$pad/$pad/" }
  10         52  
98 18 100       30 if (length($dir) == 6) { return "$dir$pad/" }
  6         15  
99 12 50       16 if (length($dir) == 10) { return $dir }
  12         27  
100 0           Carp::confess("how do I pad '$dir' ?");
101             }
102              
103             1;