cg-Xfetchprogress

   1 #!/usr/bin/env perl
   2 #
   3 # Show a cute progressbar for cg-fetch
   4 # Copyright (c) Petr Baudis, 2005
   5 #
   6 # This file shows a progressbar for cg-fetch based on output of rsync
   7 # or native git fetchers. It is written in perl because I cannot figure
   8 # out a way to check a file size without slowing the fetch by a factor
   9 # of four.
  10
  11 use warnings;
  12 use strict;
  13
  14 # Even line-buffering is bad since we output no newlines normally.
  15 $| = 1;
  16
  17 my $_git_objects = shift;
  18
  19 my $objects = 0;
  20 my $size = 0;
  21 my $osize = 0;
  22 my $percentage = '';
  23
  24 my $object = '';
  25 my $timeout = 1;
  26
  27 my $rin = '';
  28 vec($rin, fileno(STDIN), 1) = 1;
  29 my $ein = $rin;
  30 while (1) {
  31         my ($rout, $eout);
  32         # POSIX might be mad at us about <> vs. select(), but what can go
  33         # wrong with $|==1?
  34         if (not select($rout = $rin, undef, $eout = $ein, $timeout)) {
  35                 # Timeout, show file progress
  36                 $timeout = 0.25; # Update more frequently
  37                 if ($object) {
  38                         my ($objid) = ($object =~ /([a-f0-9]{12})[^\/]*$/);
  39                         my $fobject = "$_git_objects/$object";
  40                         if (-e $fobject or -e ($fobject .= ".temp")) {
  41                                 my $fsize = (stat("$fobject"))[7];
  42                                 $size = $osize + $fsize;
  43                                 progress(', now fetching '.$objid.'... ('.$fsize.' bytes)');
  44                         }
  45                 }
  46
  47         } elsif (vec($eout, fileno(STDIN), 1)) {
  48 finish:
  49                 # Error - fetch agent is probably finished
  50                 print "\n";
  51                 exit 0;
  52
  53         } else {
  54                 # Next line from the fetch agent
  55                 $timeout = 1; # ...seconds before we show per-file progress
  56                 getline() or goto finish;
  57         }
  58 }
  59
  60
  61 sub getline {
  62         $_ = <STDIN>;
  63         return 0 if not defined $_;
  64         chomp;
  65
  66         # git fetcher
  67         if (m#^(link|symlink|copy|got) ([a-f0-9]{2})([a-f0-9]{38})#) {
  68                 $object = "$2/$3";
  69
  70         } elsif (m#^(ref|walk) ([a-f0-9]{2})([a-f0-9]{38})#) {
  71                 return 1; # redundant information
  72
  73         # rsync
  74         } elsif (m#^([a-f0-9]{2})/([a-f0-9]{38})$#) {
  75                 $object = $_;
  76                 # Estimate percentage done using the position of
  77                 # the object subdir. It might not get all the way
  78                 # up to 100% ...
  79                 $percentage = ', ' . int(hex($1) * 100 / 0xff) . '% done';
  80
  81         # rsync packs
  82         } elsif (m#^pack/pack-(.+)$#) {
  83                 $object = $_;
  84                 print "Getting pack file $_\033[K\n";
  85                 progress('');
  86                 return 1;
  87
  88         # some rsync versions output this
  89         } elsif (m#^([a-f0-9]{2})/$#) {
  90                 return 1;
  91
  92         # misc. output
  93         } else {
  94                 if (m#^Getting index for pack ([a-f0-9]{40})#) {
  95                         $object = "pack/pack-$1.idx";
  96                 } elsif (m#^Getting pack ([a-f0-9]{40})#) {
  97                         $object = "pack/pack-$1.pack";
  98                 }
  99
 100                 print "$_\033[K\n";
 101                 progress('');
 102                 return 1;
 103         }
 104
 105         my $fobject = "$_git_objects/$object";
 106         -e $fobject and $size += (stat($fobject))[7];
 107         $osize = $size;
 108         $objects++;
 109
 110         progress('');
 111         return 1;
 112 }
 113
 114 sub progress {
 115         print "progress: $objects objects, $size bytes$percentage$_[0]\033[K\r";
 116 }