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