contrib/blameview/blameview.perl

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