| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Mogstored::FIDStatter; | 
| 2 | 1 |  |  | 1 |  | 25753 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 38 |  | 
| 3 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 34 |  | 
| 4 | 1 |  |  | 1 |  | 4 | use Carp qw(croak); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 2002 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | # on_fid => sub { my ($fidid, $size) = @_; ... } | 
| 7 |  |  |  |  |  |  | # t_stat => sub { my $fid = shift } | 
| 8 |  |  |  |  |  |  | sub new { | 
| 9 | 3 |  |  | 3 | 0 | 8946 | my ($class, %opts) = @_; | 
| 10 | 3 |  |  |  |  | 11 | my $self = bless {}, $class; | 
| 11 | 3 |  |  |  |  | 10 | foreach (qw(dir from to on_fid t_stat)) { | 
| 12 | 15 |  |  |  |  | 45 | $self->{$_} = delete $opts{$_}; | 
| 13 |  |  |  |  |  |  | } | 
| 14 | 3 | 50 |  |  |  | 17 | croak("unknown opts") if %opts; | 
| 15 | 3 |  | 50 | 0 |  | 12 | $self->{on_fid} ||= sub {}; | 
|  | 0 |  |  |  |  | 0 |  | 
| 16 | 3 |  | 50 | 0 |  | 14 | $self->{t_stat} ||= sub {}; | 
|  | 0 |  |  |  |  | 0 |  | 
| 17 | 3 |  |  |  |  | 11 | return $self; | 
| 18 |  |  |  |  |  |  | } | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | sub run { | 
| 21 | 4 |  |  | 4 | 0 | 104132 | my $self = shift; | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | # min/max dirs we could possibly care about format: "n/nnn/nnn/" | 
| 24 | 4 |  |  |  |  | 104 | my $min_dir = dir($self->{from}); | 
| 25 | 4 |  |  |  |  | 11 | 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 |  |  |  |  | 17 | my $min_zpad = zeropad($self->{from}); | 
| 31 | 4 |  |  |  |  | 9 | my $max_zpad = zeropad($self->{to}); | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | my $dir_in_range = sub { | 
| 34 | 15 |  |  | 15 |  | 23 | my $dir = shift; # "n/[nnn/[nnnn/]]" | 
| 35 | 15 | 100 |  |  |  | 31 | return 0 if max_subdir($dir) lt $min_dir; | 
| 36 | 13 | 100 |  |  |  | 61 | return 0 if min_subdir($dir) gt $max_dir; | 
| 37 | 12 |  |  |  |  | 33 | return 1; | 
| 38 | 4 |  |  |  |  | 26 | }; | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | my $file_in_range = sub { | 
| 41 | 508 |  |  | 508 |  | 1075 | my $fid = zeropad(shift); | 
| 42 | 508 |  | 66 |  |  | 3402 | return $fid ge $min_zpad && $fid le $max_zpad; | 
| 43 | 4 |  |  |  |  | 16 | }; | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | foreach_dentry($self->{dir}, qr/^\d$/, sub { | 
| 46 | 6 |  |  | 6 |  | 93 | my ($bdir, $dir) = @_; | 
| 47 | 6 | 100 |  |  |  | 17 | return unless $dir_in_range->("$bdir/"); | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | foreach_dentry($dir, qr/^\d{3}$/, sub { | 
| 50 | 3 |  |  |  |  | 7 | my ($mdir, $dir) = @_; | 
| 51 | 3 | 50 |  |  |  | 9 | return unless $dir_in_range->("$bdir/$mdir/"); | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | foreach_dentry($dir, qr/^\d{3}$/, sub { | 
| 54 | 6 |  |  |  |  | 143 | my ($tdir, $dir) = @_; | 
| 55 | 6 | 50 |  |  |  | 22 | return unless $dir_in_range->("$bdir/$mdir/$tdir/"); | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | foreach_dentry($dir, qr/^\d+\.fid$/, sub { | 
| 58 | 508 |  |  |  |  | 4718 | my ($file, $fullfile) = @_; | 
| 59 | 508 |  |  |  |  | 2305 | my ($fid) = ($file =~ /^0*(\d+)\.fid$/); | 
| 60 | 508 | 100 |  |  |  | 979 | return unless $file_in_range->($fid); | 
| 61 |  |  |  |  |  |  |  | 
| 62 | 507 |  |  |  |  | 1461 | $self->{t_stat}->($fid); | 
| 63 | 507 |  |  |  |  | 15825 | my $size = (stat($fullfile))[9]; | 
| 64 | 507 | 50 |  |  |  | 2665 | $self->{on_fid}->($fid, $size) if $size; | 
| 65 | 6 |  |  |  |  | 85 | }); | 
| 66 | 3 |  |  |  |  | 29 | }); | 
| 67 | 3 |  |  |  |  | 31 | }); | 
| 68 | 4 |  |  |  |  | 42 | }); | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | sub zeropad { | 
| 72 | 516 |  |  | 516 | 0 | 671 | my $fid = shift; | 
| 73 | 516 |  |  |  |  | 1274 | return "0"x(25-length($fid)) . $fid; | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | sub foreach_dentry { | 
| 77 | 16 |  |  | 16 | 0 | 28 | my ($dir, $re, $code) = @_; | 
| 78 | 16 | 50 |  |  |  | 715 | opendir(my $dh, $dir) or die "Failed to open $dir: $!"; | 
| 79 | 16 |  |  |  |  | 1922 | $code->($_, "$dir/$_") foreach sort grep { /$re/ } readdir($dh); | 
|  | 555 |  |  |  |  | 2994 |  | 
| 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 | 14 | my $fid = shift; | 
| 86 | 8 |  |  |  |  | 35 | $fid =~ s!^0*!!; | 
| 87 | 8 | 100 |  |  |  | 32 | $fid = "0"x(10-length($fid)) . $fid if length($fid) < 10; | 
| 88 | 8 |  |  |  |  | 38 | my ($b, $mmm, $ttt) = $fid =~ m{^(\d)(\d{3})(\d{3})}; | 
| 89 | 8 |  |  |  |  | 26 | return "$b/$mmm/$ttt/"; | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  |  | 
| 92 | 15 |  |  | 15 | 0 | 40 | sub max_subdir { pad_dir($_[0], "999"); } | 
| 93 | 13 |  |  | 13 | 0 | 27 | sub min_subdir { pad_dir($_[0], "000"); } | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | sub pad_dir { | 
| 96 | 28 |  |  | 28 | 0 | 38 | my ($dir, $pad) = @_; | 
| 97 | 28 | 100 |  |  |  | 73 | if (length($dir) ==  2) { return "$dir$pad/$pad/" } | 
|  | 10 |  |  |  |  | 136 |  | 
| 98 | 18 | 100 |  |  |  | 38 | if (length($dir) ==  6) { return "$dir$pad/"      } | 
|  | 6 |  |  |  |  | 24 |  | 
| 99 | 12 | 50 |  |  |  | 30 | if (length($dir) == 10) { return $dir             } | 
|  | 12 |  |  |  |  | 40 |  | 
| 100 | 0 |  |  |  |  |  | Carp::confess("how do I pad '$dir' ?"); | 
| 101 |  |  |  |  |  |  | } | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | 1; |