File Coverage

blib/lib/Yars/Command/yars_generate_diskmap.pm
Criterion Covered Total %
statement 62 75 82.6
branch 16 20 80.0
condition 1 5 20.0
subroutine 7 10 70.0
pod 0 2 0.0
total 86 112 76.7


line stmt bran cond sub pod time code
1             package Yars::Command::yars_generate_diskmap;
2              
3             # PODNAME: yars_generate_diskmap
4             # ABSTRACT: generate a mapping from servers + hosts to buckets for yars.
5             our $VERSION = '1.31'; # VERSION
6              
7              
8 2     2   80314 use strict;
  2         4  
  2         72  
9 2     2   11 use warnings;
  2         3  
  2         44  
10 2     2   236 use JSON::MaybeXS ();
  2         3903  
  2         39  
11 2     2   502 use Getopt::Long qw( GetOptions );
  2         7741  
  2         39  
12 2     2   754 use Pod::Usage qw( pod2usage );
  2         45708  
  2         138  
13 2     2   17 use feature 'say';
  2         4  
  2         1410  
14              
15             sub main {
16 5     5 0 26427 my $class = shift;
17 5         15 local @ARGV = @_;
18 5         8 my %servers;
19 5         11 my $default_port = 9001;
20 5         8 my $protocol = 'http';
21             GetOptions(
22             'port|p=i' => \$default_port,
23             'protocol=s' => \$protocol,
24 0     0   0 'help|h' => sub { pod2usage({ -verbose => 2}) },
25             'version' => sub {
26 0   0 0   0 say 'Yars version ', ($Yars::Command::yars_generate_diskmap::VERSION // 'dev');
27 0         0 exit 1;
28             },
29 5 50       41 ) || pod2usage(1);
30 5 50       1952 my $digits = shift @ARGV or die "no number of digits given";
31 5         11 my @all;
32 5         137 while (<>) {
33 14         27 chomp;
34 14         26 s/#.*$//; # remove comments
35 14 50       39 next if /^\s*$/; # skip empty lines
36 14         38 my ($host,$disk) = split;
37 14         21 my $port;
38 14 100       35 $port = $1 if $host =~ s/:(\d+)$//;
39 14         24 $host =~ tr/a-zA-Z0-9.\-//dc;
40 14 100       25 $host = join ':', $host, $port if $port;
41 14 50 33     44 die "could not parse line : \"$_\"" unless $host && $disk;
42 14         39 $servers{$host}{$disk} = [];
43 14         77 push @all, $servers{$host}{$disk};
44             }
45              
46 5         13 my $i = 0;
47 5         19 for my $bucket (0..16**$digits-1) {
48 1040         1716 my $b = sprintf( '%0'.$digits.'x',$bucket);
49 1040         1150 push @{ $all[$i] }, "$b";
  1040         1635  
50 1040         1164 $i++;
51 1040 100       1655 $i = 0 if $i==@all;
52             }
53              
54 5         119 say '---';
55 5         26 say 'servers :';
56 5         24 for my $host (sort keys %servers) {
57 8 100       60 say "- url : $protocol://" . ($host =~ /:\d+$/ ? $host : join(':', $host, $default_port));
58 8         26 say " disks :";
59 8         14 for my $root (sort keys %{ $servers{$host} }) {
  8         31  
60 14         56 say " - root : $root";
61 14         45 print " buckets : [";
62 14         23 my $i = 1;
63 14         17 for my $bucket (@{ $servers{$host}{$root} }) {
  14         35  
64 1040 100       1890 print "\n " if $i++%14 == 0;
65 1040         3255 print " $bucket";
66 1040 100       1310 print "," unless $i==@{ $servers{$host}{$root} }+1;
  1040         4098  
67             }
68 14         128 say " ]";
69             }
70             }
71             }
72              
73             sub dense {
74 0     0 0   my %servers = @_;
75             # Alternative unreadable representation
76 0           my @conf;
77 0           for my $host (sort keys %servers) {
78             push @conf, +{ url => "http://$host:9001", disks => [
79 0           map +{ root => $_, buckets => $servers{$host}{$_} }, keys %{ $servers{$host} }
  0            
80             ]};
81             }
82              
83 0           my $out = JSON::MaybeXS->new->space_after->encode({ servers => \@conf });
84 0           $out =~ s/{/\n{/g;
85 0           $out =~ s/\[/\n[/g;
86 0           $out =~ s/\],/],\n/g;
87 0           print $out,"\n";
88             }
89              
90             1;
91              
92             __END__
93              
94             =pod
95              
96             =head1 NAME
97              
98             Yars::Command::yars_generate_diskmap - code for yars_generate_diskmap
99              
100             =head1 DESCRIPTION
101              
102             This module contains the machinery for the command line program L<yars_generate_diskmap>
103              
104             =head1 SEE ALSO
105              
106             L<yars_disk_scan>
107              
108             =cut