git-filter-index

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my @filters = ();
   7 for(@ARGV)
   8 {
   9         if(/^
  10                 (?<want>[-+])
  11                 s
  12                         (?<delimiter>.)
  13                         (?<search>.*?)
  14                         \k<delimiter>
  15                         (?<replace>.*)
  16                         \k<delimiter>
  17         $/sx)
  18         {
  19                 push @filters, {
  20                         search => $+{search},
  21                         replace => $+{replace},
  22                         want => $+{want} eq '+'
  23                 };
  24         }
  25         elsif(/^
  26                 (?<want>[-+])
  27                 (?:
  28                         m
  29                                 (?<delimiter>.)
  30                         |
  31                         (?<delimiter>\/)
  32                 )
  33                         (?<search>.*?)
  34                         \k<delimiter>
  35         $/sx)
  36         {
  37                 push @filters, {
  38                         search => $+{search},
  39                         replace => undef,
  40                         want => $+{want} eq '+'
  41                 };
  42         }
  43         elsif(/^
  44                 (?<want>[-+])
  45         $/sx)
  46         {
  47                 push @filters, {
  48                         search => '^',
  49                         replace => undef,
  50                         want => $+{want} eq '+'
  51                 };
  52         }
  53         else
  54         {
  55                 die "Usage: $0 filterexpression filterexpression..., where a filter expression is of the form +s/search/replace/, +m/search/, +, -s/search/replace/, -m/search/, -";
  56         }
  57 }
  58
  59 sub fillin($@)
  60 {
  61         my ($str, @args) = @_;
  62         $str =~ s{\\([1-9])|(\&)|(\\)\\}{
  63                 $1 ? $args[$1] : $2 ? $args[0] : $3
  64         }ge;
  65         return $str;
  66 }
  67
  68 my $current_output = $ENV{output};
  69 sub filter($)
  70 {
  71         my ($s) = @_;
  72         for(@filters)
  73         {
  74                 my ($search, $replace, $want) = ($_->{search}, $_->{replace}, $_->{want});
  75                 my $fn = $s;
  76                 if($fn =~ s/$search/defined $replace ? fillin $replace, $&, map { substr($s, $-[$_], $+[$_] - $-[$_]) } 0..(@+ - 1) : $&/se)
  77                 {
  78                         $fn = $s unless $want;
  79                         return ($fn, $want);
  80                 }
  81         }
  82         # nothing matched
  83         return ($s, 0);
  84 }
  85
  86 open my $infh, '-|', 'git', 'ls-files', '-s';
  87 my $idx = "";
  88 my $plus = 0;
  89 my $minus = 0;
  90 while(<$infh>)
  91 {
  92         chomp;
  93         /^(\d+) ([0-9a-f]+) (\d+)\t(.*)$/ or die "invalid index line: $_";
  94         my ($mode, $hash, $stageno, $filename) = ($1, $2, $3, $4);
  95         my ($filename_new, $want) = filter($filename);
  96         if($want)
  97         {
  98                 $idx .= "0 0000000000000000000000000000000000000000 $stageno\t$filename\n"
  99                         if $filename ne $filename_new;
 100                 $idx .= "$mode $hash $stageno\t$filename_new\n";
 101                 ++$plus;
 102         }
 103         else
 104         {
 105                 $idx .= "0 0000000000000000000000000000000000000000 $stageno\t$filename\n";
 106                 ++$minus;
 107         }
 108 }
 109 close $infh
 110         or die "git-ls-files: $!";
 111
 112 print "$plus:$minus\n";
 113
 114 open my $outfh, ">", "/tmp/idxtest";
 115 print $outfh $idx;
 116 close $outfh;
 117
 118 open my $outfh, '|-', 'git', 'update-index', '--index-info';
 119 print $outfh $idx;
 120 close $outfh
 121         or die "git-update-index: $!";