toolbox/show-pack-counts.pl

   1 #!/usr/bin/perl
   2
   3 # Show projects' pack and/or object counts
   4 # Use "show-pack-counts.pl --sorted" to see in pack count order
   5 # Use the --objects option to show pack object counts instead of pack counts
   6
   7 use strict;
   8 use warnings;
   9 use vars qw($VERSION);
  10 BEGIN {*VERSION = \'2.0'}
  11 use File::Basename;
  12 use Getopt::Long;
  13 use Pod::Usage;
  14 BEGIN {
  15         eval 'require Pod::Text::Termcap; 1;' and
  16         @Pod::Usage::ISA = (qw( Pod::Text::Termcap ));
  17         defined($ENV{PERLDOC}) && $ENV{PERLDOC} ne "" or
  18         $ENV{PERLDOC} = "-oterm -oman";
  19 }
  20 use lib "__BASEDIR__";
  21 use Girocco::Config;
  22 use Girocco::Project;
  23 use Girocco::CLIUtil;
  24
  25 my $shbin;
  26 BEGIN {
  27     $shbin = $Girocco::Config::posix_sh_bin;
  28     defined($shbin) && $shbin ne "" or $shbin = "/bin/sh";
  29 }
  30
  31 $| = 1;
  32 select((select(STDERR), $| = 1)[0]);
  33 exit(&main(@ARGV)||0);
  34
  35 my ($quiet, $progress);
  36
  37 sub die_usage {
  38         pod2usage(-exitval => 2);
  39 }
  40
  41 sub die_usage_msg {
  42         warn(@_);
  43         pod2usage(-exitval => 2);
  44 }
  45
  46 sub do_help {
  47         pod2usage(-verbose => 2, -exitval => 0);
  48 }
  49
  50 sub do_version {
  51         print basename($0), " version ", $VERSION, "\n";
  52         exit 0;
  53 }
  54
  55 sub defval {
  56         return defined($_[0]) ? $_[0] : $_[1];
  57 }
  58
  59 my ($lastpct, $lastts);
  60
  61 sub progress {
  62         return unless $progress;
  63         my ($prog, $total, $prefix) = @_;
  64         $total or $total = 100;
  65         defined $prefix or $prefix = "";
  66         my $now = time();
  67         defined $lastts or $lastts = $now + 1;
  68         if ($now > $lastts) {
  69                 $lastts = $now;
  70                 defined $lastpct or $lastpct = "";
  71                 my $pct = int($prog * 100 / $total);
  72                 $pct = 100 if $pct > 100;
  73                 if ($pct ne $lastpct) {
  74                         $lastpct = $pct;
  75                         $prefix ne "" and $prefix .= " ";
  76                         printf STDERR "\r%s%3d%%", $prefix, $pct;
  77                 }
  78         }
  79 }
  80
  81 sub progress_done {
  82         return unless $progress && defined($lastpct);
  83         my $prefix = $_[0];
  84         defined $prefix or $prefix = "";
  85         $prefix ne "" and $prefix .= " ";
  86         printf STDERR "\r%s100%%, done.\n", $prefix;
  87 }
  88
  89 my ($packs, $packobjs, $loose, $sorton);
  90
  91 sub main {
  92         local *ARGV = \@_;
  93         my ($help, $version, $asc);
  94
  95         close(DATA) if fileno(DATA);
  96         $progress = -t 2;
  97         Getopt::Long::Configure('bundling');
  98         $_ eq "--sorted" || $_ eq "--sort" and $_ .= "=" foreach @_;
  99         GetOptions(
 100                 'help|h'                => sub {do_help},
 101                 'version|V'             => sub {do_version},
 102                 'quiet|q'               => sub {$progress = 0},
 103                 'progress|P'            => \$progress,
 104                 'objects|packed'        => sub {$packobjs = 1},
 105                 'no-objects|no-packed'  => sub {$packobjs = 0},
 106                 'packs'                 => sub {$packs = 1},
 107                 'no-packs'              => sub {$packs = 0},
 108                 'loose'                 => sub {$loose = 1},
 109                 'no-loose'              => sub {$loose = 0},
 110                 'full'                  => sub {$packs = $packobjs = $loose = 1;
 111                                         $sorton = "objects"},
 112                 'sorted|sort:s'         => \$sorton,
 113         ) or die_usage;
 114         $packs = 1 if !defined($packs) && !defval($packobjs,0) && !defval($loose,0);
 115         $packobjs = 1 if !defined($packobjs) && defined($packs) && !$packs && !defval($loose,0);
 116         $packobjs || $packs || $loose or
 117                 die_usage_msg "At least one of --packs, --objects or --loose must be active\n";
 118         if (defined($sorton)) {
 119                 $sorton =~ /^\+/ and $asc = 1;
 120                 $sorton =~ s/^[+-]//;
 121                 $sorton eq "" and $sorton = $packs ? "packs" : "objects";
 122                 $sorton =~ tr/A-Z/a-z/;
 123                 if ($sorton eq "packs") {
 124                         $packs or die_usage_msg "Sorting on \"packs\" requires the --packs option\n";
 125                 } elsif ($sorton eq "loose") {
 126                         $loose or die_usage_msg "Sorting on \"loose\" requires the --loose option\n";
 127                 } elsif ($sorton eq "packed") {
 128                         $packobjs or die_usage_msg "Sorting on \"packed\" requires the --objects option\n";
 129                 } elsif ($sorton eq "objects") {
 130                         $loose || $packobjs or
 131                                 die_usage_msg "Sorting on \"objects\" requires the --objects and/or --loose option\n";
 132                         if ($loose && !$packobjs) {
 133                                 $sorton = "loose";
 134                         } elsif ($packobjs && !$loose) {
 135                                 $sorton = "packed";
 136                         }
 137                 } else {
 138                         die_usage_msg "Unknown sort field: $sorton\n";
 139                 }
 140         } else {
 141                 $progress = 0;
 142         }
 143
 144         nice_me();
 145         my @projlist = ();
 146         my $reporoot = $Girocco::Config::reporoot;
 147         if (@_) {
 148                 my %projs = map {($_ => 1)} Girocco::Project::get_full_list;
 149                 foreach (@_) {
 150                         s,/+$,,;
 151                         my $p = $_;
 152                         exists($projs{$p}) and push(@projlist, $p), next;
 153                         $p =~ s/\.git$//i && exists($projs{$p}) and push(@projlist, $p), next;
 154                         $p =~ s,^\Q$reporoot\E/,, && exists($projs{$p}) and push(@projlist, $p), next;
 155                         warn "Ignoring unknown project: $_\n";
 156                 }
 157                 @projlist or exit 1;
 158         } else {
 159                 @projlist = sort({lc($a) cmp lc($b)} Girocco::Project::get_full_list);
 160         }
 161
 162         my @results = ();
 163         my $pmsg = "Inspecting projects:";
 164         foreach my $proj (@projlist) {
 165                 my ($pcks, $pobjs, $lobjs) =
 166                         inspect_proj("$reporoot/$proj.git", $packs, $packobjs, $loose);
 167                 if ($sorton) {
 168                         push(@results, [$proj, $pcks, $pobjs, $lobjs]);
 169                         progress(scalar(@results), scalar(@projlist), $pmsg);
 170                 } else {
 171                         show_one($proj, $pcks, $pobjs, $lobjs);
 172                 }
 173         }
 174         if ($sorton) {
 175                 progress_done($pmsg);
 176                 my $sorter;
 177                 my $desc = $asc ? 1 : -1;
 178                 $sorton eq "packs" and $sorter = sub {
 179                         my $x = $$a[1] <=> $$b[1];
 180                         $x *= $desc;
 181                         $x or $x = lc($$a[0]) cmp lc($$b[0]);
 182                         return $x;
 183                 };
 184                 $sorton eq "packed" and $sorter = sub {
 185                         my $x = $$a[2] <=> $$b[2];
 186                         $x *= $desc;
 187                         $x or $x = lc($$a[0]) cmp lc($$b[0]);
 188                         return $x;
 189                 };
 190                 $sorton eq "loose" and $sorter = sub {
 191                         my $x = $$a[3] <=> $$b[3];
 192                         $x *= $desc;
 193                         $x or $x = lc($$a[0]) cmp lc($$b[0]);
 194                         return $x;
 195                 };
 196                 $sorton eq "objects" and $sorter = sub {
 197                         my $x = ($$a[2] + $$a[3]) <=> ($$b[2] + $$b[3]);
 198                         $x *= $desc;
 199                         $x or $x = lc($$a[0]) cmp lc($$b[0]);
 200                         return $x;
 201                 };
 202                 foreach my $info (sort($sorter @results)) {
 203                         show_one(@$info);
 204                 }
 205         }
 206         exit 0;
 207 }
 208
 209 sub show_one {
 210         my ($name, $pcks, $pobjs, $lobjs) = @_;
 211         my $line = "";
 212         if (defined($sorton)) {
 213                 $sorton eq "packs" and $line .= $pcks;
 214                 $sorton eq "packed" and $line .= $pobjs;
 215                 $sorton eq "loose" and $line .= $lobjs;
 216                 $sorton eq "objects" and $line .= ($pobjs + $lobjs);
 217         } else {
 218                 if ($packs) {
 219                         $line .= $pcks;
 220                 } elsif ($packobjs && $loose) {
 221                         $line .= ($pobjs + $lobjs);
 222                 } elsif ($packobjs) {
 223                         $line .= $pobjs;
 224                 } else {
 225                         $line .= $lobjs;
 226                 }
 227         }
 228         $line .= "\t$name";
 229         my @info = ();
 230         $packs and push(@info, "packs: " . $pcks);
 231         $packobjs and push(@info, "packed: " . $pobjs);
 232         $loose and push(@info, "loose: " . $lobjs);
 233         if (@info > 1) {
 234                 length($name) < 8 and $line .= "\t";
 235                 length($name) < 16 and $line .= "\t";
 236                 length($name) < 24 and $line .= "\t";
 237                 $line .= " \t(" . join(", ", @info) . ")";
 238         }
 239         print $line, "\n";
 240 }
 241
 242 my ($lpbin, @lpcmd);
 243 BEGIN {
 244   $lpbin = $Girocco::Config::basedir . "/bin/list_packs";
 245   @lpcmd = ($lpbin, "--exclude-no-idx");
 246 }
 247
 248 sub count_proj_packs {
 249         my $projdir = shift;
 250         my $objs = shift;
 251         my $pd = $projdir . "/objects/pack";
 252         -d $pd or warn("no such project path (anymore) $pd\n"), return undef;
 253         open LPCMD, '-|', @lpcmd, ($objs ? "--count-objects" : "--count"), $pd or
 254                 warn("failed to run list_packs for project dir $pd\n"), return undef;
 255         my $pcount = <LPCMD>;
 256         chomp($pcount);
 257         close LPCMD;
 258         $pcount =~ /^\d+$/ or
 259                 warn("list_packs produced invalid output for project dir $pd\n"), return undef;
 260         return 0 + $pcount;
 261 }
 262
 263 my ($octet, $octet19);
 264 BEGIN {
 265     $octet = '[0-9a-f][0-9a-f]';
 266     $octet19 = $octet x 19;
 267 }
 268
 269 sub count_proj_loose {
 270         my $projdir = shift;
 271         my $od = $projdir . "/objects";
 272         -d $od or warn("no such project path (anymore) $od\n"), return undef;
 273         open FINDCMD, '-|', $shbin, '-c', "cd " . quotemeta($od) . " && " .
 274                 "find -L $octet -maxdepth 1 -name '$octet19*' -print 2>/dev/null | wc -l" or
 275                 warn("failed to run find for project dir $od\n"), return undef;
 276         my $ocount = <FINDCMD>;
 277         $ocount =~ s/\s+//gs;
 278         close FINDCMD;
 279         $ocount =~ /^\d+$/ or
 280                 warn("find + wc produced invalid output for project dir $od\n"), return undef;
 281         return 0 + $ocount;
 282 }
 283
 284 sub inspect_proj {
 285         my $path = shift;
 286         my ($pcks, $pobjs, $lobjs);
 287         $pcks = count_proj_packs($path) || 0 if $packs;
 288         $pobjs = count_proj_packs($path, 1) || 0 if $packobjs;
 289         $lobjs = count_proj_loose($path) || 0 if $loose;
 290         return ($pcks, $pobjs, $lobjs);
 291 }
 292
 293 __END__
 294
 295 =head1 NAME
 296
 297 show-pack-counts.pl - show projects' pack and/or object counts
 298
 299 =head1 SYNOPSIS
 300
 301 show-pack-counts.pl [<options>] [<projname>...]
 302
 303  Options:
 304    -h | --help                  detailed instructions
 305    -V | --version               show version
 306    -q | --quiet                 suppress progress messages
 307    -P | --progress              show progress messages (default)
 308    --sorted[=[+]<field>]        sort output on <field>
 309    --objects                    count objects in packs instead of packs
 310    --no-objects                 omit objects in packs count (default)
 311    --packs                      always include pack count
 312    --no-packs                   always omit pack count
 313    --loose                      count loose objects (implies --no-packs)
 314    --no-loose                   omit loose objects count (default)
 315    --full                       shortcut meta option that sets
 316                                 --packs --objects --loose --sorted=objects
 317
 318  <field> can be loose, packed, packs or objects and may be preceded by an
 319  optional + to sort in ascending rather than descending order.
 320  If no sorted option is given output will be shown unsorted as it's gathered.
 321  The default sort field depends on the options being packs if pack counts are
 322  included and objects otherwise.  Using a field name of + changes the
 323  default sorting order to ascending without changing the default sort field.
 324
 325  <projname>...                  if given, only inspect these projects
 326
 327 =head1 OPTIONS
 328
 329 =over 8
 330
 331 =item B<-h>, B<--help>
 332
 333 Print the full description of show-pack-counts.pl's options.
 334
 335 =item B<-V>, B<--version>
 336
 337 Print the version of show-pack-counts.pl.
 338
 339 =item B<-q>, B<--quiet>
 340
 341 Suppress progress messages.  There are never any progress messages unless
 342 sorted output is active.
 343
 344 =item B<-P>, B<--progress>
 345
 346 Show progress information to STDERR while collecting sorted output.  This is
 347 the default unless STDERR is not a TTY.
 348
 349 =item B<--sorted[=>I<<fieldE<gt>>B<]>
 350
 351 Collect all the output first and then show it in sorted order.
 352
 353 Possible I<<fieldE<gt>> names are:
 354
 355 =over 8
 356
 357 =item B<[+]loose>
 358
 359 Sort by number of loose objects (requires B<--loose> option too)
 360
 361 =item B<[+]packed>
 362
 363 Sort by total number of objects in packs (requires B<--objects> option too)
 364
 365 =item B<[+]packs>
 366
 367 Sort by total number of packs (requires possibly implied B<--packs> option)
 368
 369 =item B<[+]<objects>
 370
 371 Sort by total objects counted (requires B<--objects> and/or B<--loose>)
 372
 373 =item B<[+]<packs>
 374
 375 Sort by total number of packs (requires possibly implied B<--packs> option)
 376
 377 =item B<+>
 378
 379 Keep the default sort field but sort in ascending order rather than descending
 380 order.  When prefixed to one of the other sort field names, sort on that field
 381 but in ascending rather than descending order.
 382
 383 =back
 384
 385 If the B<--sorted=[+]<field>> option is given more than once then later options
 386 override earlier ones (there is no multi-field sorting).  This can be used to
 387 change the sorting order used with B<--full>.
 388
 389 If B<--sorted> is used (or B<--sorted=+>) the sort field is chosen based on
 390 what information is being collected.  If packs are being counted the sort will
 391 be on the number of packs (B<--sorted=packs>).
 392
 393 If packs are not being counted the sort will be on the total number of objects
 394 in each project being either objects in packs, loose objects or the sum of
 395 both objects in packs and loose objects depending on what options have been
 396 given (B<--sorted=objects>).
 397
 398 =item B<--objects>
 399
 400 Instead of counting packs, count objects in them.  Implies B<--no-packs>
 401 unless an explicit B<--packs> is given too.
 402
 403 =item B<--no-objects>
 404
 405 Omit the count of objects in packs.  Included for completeness.  Reactivates
 406 implicit B<--packs> if given.
 407
 408 =item B<--packs>
 409
 410 Count the number of packs present.  This is implied by default but may be
 411 given explicitly to always include the packs count.
 412
 413 =item B<--no-packs>
 414
 415 Omit the count of packs.  At least one other counting option must be specified
 416 with this (either B<--objects> or B<--loose>).
 417
 418 =item B<--loose>
 419
 420 Count loose objects.
 421
 422 =item B<--no-loose>
 423
 424 Do not count loose objects.
 425
 426 =item B<--full>
 427
 428 A shortcut meta option that behaves the same as replacing it with B<--packs>
 429 B<--objects> B<--loose> B<--sorted=objects> at that point.
 430
 431 =item I<<projnameE<gt>>
 432
 433 If no project names are specified then I<all> projects are processed.
 434
 435 If one or more project names are specified then only those projects are
 436 processed.  Specifying non-existent projects produces a warning for them,
 437 but the rest of the projects specified will still be processed.
 438
 439 Each B<projname> may be either a full absolute path starting with
 440 $Girocco::Config::reporoot or just the project name part with or without
 441 a trailing C<.git>.
 442
 443 Any explicitly specified projects that do exist but are not known to
 444 Girocco will be skipped (with a warning).
 445
 446 =back
 447
 448 =head1 DESCRIPTION
 449
 450 Count the number of packs, objects contained in packs and/or loose objects
 451 and show the results.
 452
 453 Output can be sorted and the projects inspected can be limited.
 454
 455 =cut