contrib/blameview/blameview.perl

   1 #!/usr/bin/perl
   2
   3 use Gtk2 -init;
   4 use Gtk2::SimpleList;
   5
   6 my $hash;
   7 my $fn;
   8 if ( @ARGV == 1 ) {
   9         $hash = "HEAD";
  10         $fn = shift;
  11 } elsif ( @ARGV == 2 ) {
  12         $hash = shift;
  13         $fn = shift;
  14 } else {
  15         die "Usage blameview [<rev>] <filename>";
  16 }
  17
  18 Gtk2::Rc->parse_string(<<'EOS');
  19 style "treeview_style"
  20 {
  21   GtkTreeView::vertical-separator = 0
  22 }
  23 class "GtkTreeView" style "treeview_style"
  24 EOS
  25
  26 my $window = Gtk2::Window->new('toplevel');
  27 $window->signal_connect(destroy => sub { Gtk2->main_quit });
  28 my $scrolled_window = Gtk2::ScrolledWindow->new;
  29 $window->add($scrolled_window);
  30 my $fileview = Gtk2::SimpleList->new(
  31     'Commit' => 'text',
  32     'CommitInfo' => 'text',
  33     'FileLine' => 'text',
  34     'Data' => 'text'
  35 );
  36 $scrolled_window->add($fileview);
  37 $fileview->get_column(0)->set_spacing(0);
  38 $fileview->set_size_request(1024, 768);
  39 $fileview->set_rules_hint(1);
  40 $fileview->signal_connect (row_activated => sub {
  41                 my ($sl, $path, $column) = @_;
  42                 my $row_ref = $sl->get_row_data_from_path ($path);
  43                 system("blameview @$row_ref[0] $fn");
  44                 # $row_ref is now an array ref to the double-clicked row's data.
  45                 });
  46
  47 my $fh;
  48 open($fh, '-|', "git cat-file blob $hash:$fn")
  49   or die "unable to open $fn: $!";
  50
  51 while(<$fh>) {
  52   chomp;
  53   $fileview->{data}->[$.] = ['HEAD', '?', "$fn:$.", $_];
  54 }
  55
  56 my $blame;
  57 open($blame, '-|', qw(git blame --incremental --), $fn, $hash)
  58     or die "cannot start git-blame $fn";
  59
  60 Glib::IO->add_watch(fileno($blame), 'in', \&read_blame_line);
  61
  62 $window->show_all;
  63 Gtk2->main;
  64 exit 0;
  65
  66 my %commitinfo = ();
  67
  68 sub flush_blame_line {
  69         my ($attr) = @_;
  70
  71         return unless defined $attr;
  72
  73         my ($commit, $s_lno, $lno, $cnt) =
  74             @{$attr}{qw(COMMIT S_LNO LNO CNT)};
  75
  76         my ($filename, $author, $author_time, $author_tz) =
  77             @{$commitinfo{$commit}}{qw(FILENAME AUTHOR AUTHOR-TIME AUTHOR-TZ)};
  78         my $info = $author . ' ' . format_time($author_time, $author_tz);
  79
  80         for(my $i = 0; $i < $cnt; $i++) {
  81                 @{$fileview->{data}->[$lno+$i-1]}[0,1,2] =
  82                     (substr($commit, 0, 8), $info,
  83                      $filename . ':' . ($s_lno+$i));
  84         }
  85 }
  86
  87 my $buf;
  88 my $current;
  89 sub read_blame_line {
  90
  91         my $r = sysread($blame, $buf, 1024, length($buf));
  92         die "I/O error" unless defined $r;
  93
  94         if ($r == 0) {
  95                 flush_blame_line($current);
  96                 $current = undef;
  97                 return 0;
  98         }
  99
 100         while ($buf =~ s/([^\n]*)\n//) {
 101                 my $line = $1;
 102
 103                 if (($commit, $s_lno, $lno, $cnt) =
 104                     ($line =~ /^([0-9a-f]{40}) (\d+) (\d+) (\d+)$/)) {
 105                         flush_blame_line($current);
 106                         $current = +{
 107                                 COMMIT => $1,
 108                                 S_LNO => $2,
 109                                 LNO => $3,
 110                                 CNT => $4,
 111                         };
 112                         next;
 113                 }
 114
 115                 # extended attribute values
 116                 if ($line =~ /^(author|author-mail|author-time|author-tz|committer|committer-mail|committer-time|committer-tz|summary|filename) (.*)$/) {
 117                         my $commit = $current->{COMMIT};
 118                         $commitinfo{$commit}{uc($1)} = $2;
 119                         next;
 120                 }
 121         }
 122         return 1;
 123 }
 124
 125 sub format_time {
 126   my $time = shift;
 127   my $tz = shift;
 128
 129   my $minutes = $tz < 0 ? 0-$tz : $tz;
 130   $minutes = ($minutes / 100)*60 + ($minutes % 100);
 131   $minutes = $tz < 0 ? 0-$minutes : $minutes;
 132   $time += $minutes * 60;
 133   my @t = gmtime($time);
 134   return sprintf('%04d-%02d-%02d %02d:%02d:%02d %s',
 135                  $t[5] + 1900, @t[4,3,2,1,0], $tz);
 136 }