]> git.cworth.org Git - notmuch/blob - contrib/nmbug
Merge branch 'release'
[notmuch] / contrib / nmbug
1 #!/usr/bin/env perl
2 # Copyright (c) 2011 David Bremner
3 # License: same as notmuch
4
5 use strict;
6 use warnings;
7 use File::Temp qw(tempdir);
8 use Pod::Usage;
9
10 no encoding;
11
12 my $NMBGIT = $ENV{NMBGIT} || $ENV{HOME}.'/.nmbug';
13
14 $NMBGIT .= '/.git' if (-d $NMBGIT.'/.git');
15
16 my $TAGPREFIX = $ENV{NMBPREFIX} || 'notmuch::';
17
18 # magic hash for git
19 my $EMPTYBLOB = 'e69de29bb2d1d6434b8b29ae775ad8c2e48c5391';
20
21 # for encoding
22
23 my $ESCAPE_CHAR =       '%';
24 my $NO_ESCAPE =         'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'.
25                         '0123456789+-_@=.:,';
26 my $MUST_ENCODE =       qr{[^\Q$NO_ESCAPE\E]};
27 my $ESCAPED_RX =        qr{$ESCAPE_CHAR([A-Fa-f0-9]{2})};
28
29 my %command = (
30              archive    => \&do_archive,
31              checkout   => \&do_checkout,
32              commit     => \&do_commit,
33              fetch      => \&do_fetch,
34              help       => \&do_help,
35              log        => \&do_log,
36              merge      => \&do_merge,
37              pull       => \&do_pull,
38              push       => \&do_push,
39              status     => \&do_status,
40              );
41
42 my $subcommand = shift || usage ();
43
44 if (!exists $command{$subcommand}) {
45   usage ();
46 }
47
48 &{$command{$subcommand}}(@ARGV);
49
50 sub git_pipe {
51   my $envref = (ref $_[0] eq 'HASH') ? shift : {};
52   my $ioref  = (ref $_[0] eq 'ARRAY') ? shift : undef;
53   my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : undef;
54
55   unshift @_, 'git';
56   $envref->{GIT_DIR} ||= $NMBGIT;
57   spawn ($envref, defined $ioref ? $ioref : (), defined $dir ? $dir : (), @_);
58 }
59
60 sub git {
61   my $fh = git_pipe (@_);
62   my $str = join ('', <$fh>);
63   chomp($str);
64   return $str;
65 }
66
67 sub spawn {
68   my $envref = (ref $_[0] eq 'HASH') ? shift : {};
69   my $ioref  = (ref $_[0] eq 'ARRAY') ? shift : undef;
70   my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : '-|';
71
72   die unless @_;
73
74   if (open my $child, $dir) {
75     return $child;
76   }
77   # child
78   while (my ($key, $value) = each %{$envref}) {
79     $ENV{$key} = $value;
80   }
81
82   if (defined $ioref && $dir eq '-|') {
83       open my $fh, '|-', @_ or die "open |- @_: $!";
84       foreach my $line (@{$ioref}) {
85         print $fh $line, "\n";
86       }
87       exit 0;
88     } else {
89       if ($dir ne '|-') {
90         open STDIN, '<', '/dev/null' or die "reopening stdin: $!"
91       }
92       exec @_;
93       die "exec @_: $!";
94     }
95 }
96
97
98 sub get_tags {
99   my $prefix = shift;
100   my @tags;
101
102   my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*")
103     or die 'error dumping tags';
104
105   while (<$fh>) {
106     chomp ();
107     push @tags, $_ if (m/^$prefix/);
108   }
109   return @tags;
110 }
111
112
113 sub do_archive {
114   system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD');
115 }
116
117
118 sub is_committed {
119   my $status = shift;
120   return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0;
121 }
122
123
124 sub do_commit {
125   my @args = @_;
126
127   my $status = compute_status ();
128
129   if ( is_committed ($status) ) {
130     print "Nothing to commit\n";
131     return;
132   }
133
134   my $index = read_tree ('HEAD');
135
136   update_index ($index, $status);
137
138   my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree')
139     or die 'no output from write-tree';
140
141   my $parent = git ( 'rev-parse', 'HEAD'  )
142     or die 'no output from rev-parse';
143
144   my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent)
145     or die 'commit-tree';
146
147   git ('update-ref', 'HEAD', $commit);
148
149   unlink $index || die "unlink: $!";
150
151 }
152
153 sub read_tree {
154   my $treeish = shift;
155   my $index = $NMBGIT.'/nmbug.index';
156   git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty');
157   git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish);
158   return $index;
159 }
160
161 sub update_index {
162   my $index = shift;
163   my $status = shift;
164
165   my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
166                      '|-', qw/git update-index --index-info/)
167     or die 'git update-index';
168
169   foreach my $pair (@{$status->{deleted}}) {
170     index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag});
171   }
172
173   foreach my $pair (@{$status->{added}}) {
174     index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag});
175   }
176 }
177
178
179 sub do_fetch {
180   my $remote = shift || 'origin';
181
182   git ('fetch', $remote);
183 }
184
185
186 sub notmuch {
187   my @args = @_;
188   system ('notmuch', @args) == 0 or die  "notmuch @args failed: $?";
189 }
190
191
192 sub index_tags {
193
194   my $index = $NMBGIT.'/nmbug.index';
195
196   my $query = join ' ', map ("tag:$_", get_tags ($TAGPREFIX));
197
198   my $fh = spawn ('-|', qw/notmuch dump --/, $query)
199     or die "notmuch dump: $!";
200
201   git ('read-tree', '--empty');
202   my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
203                      '|-', qw/git update-index --index-info/)
204     or die 'git update-index';
205
206   while (<$fh>) {
207     m/ ( [^ ]* ) \s+ \( ([^\)]* ) \) /x || die 'syntax error in dump';
208     my ($id,$rest) = ($1,$2);
209
210     #strip prefixes before writing
211     my @tags = grep { s/^$TAGPREFIX//; } split (' ', $rest);
212     index_tags_for_msg ($git,$id, 'A', @tags);
213   }
214
215   close $git;
216   return $index;
217 }
218
219 sub index_tags_for_msg {
220   my $fh = shift;
221   my $msgid = shift;
222   my $mode = shift;
223
224   my $hash = $EMPTYBLOB;
225   my $blobmode = '100644';
226
227   if ($mode eq 'D') {
228     $blobmode = '0';
229     $hash = '0000000000000000000000000000000000000000';
230   }
231
232   foreach my $tag (@_) {
233     my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag);
234     print $fh "$blobmode $hash\t$tagpath\n";
235   }
236 }
237
238
239 sub do_checkout {
240   do_sync (action => 'checkout');
241 }
242
243
244 sub do_sync {
245
246   my %args = @_;
247
248   my $status = compute_status ();
249   my ($A_action, $D_action);
250
251   if ($args{action} eq 'checkout') {
252     $A_action = '-';
253     $D_action = '+';
254   } else {
255     $A_action = '+';
256     $D_action = '-';
257   }
258
259   foreach my $pair (@{$status->{added}}) {
260
261     notmuch ('tag', $A_action.$TAGPREFIX.$pair->{tag},
262              'id:'.$pair->{id});
263   }
264
265   foreach my $pair (@{$status->{deleted}}) {
266     notmuch ('tag', $D_action.$TAGPREFIX.$pair->{tag},
267              'id:'.$pair->{id});
268   }
269
270 }
271
272
273 sub insist_committed {
274
275   my $status=compute_status();
276   if ( !is_committed ($status) ) {
277     print "Uncommitted changes to $TAGPREFIX* tags in notmuch
278
279 For a summary of changes, run 'nmbug status'
280 To save your changes,     run 'nmbug commit' before merging/pull
281 To discard your changes,  run 'nmbug checkout'
282 ";
283     exit (1);
284   }
285
286 }
287
288
289 sub do_pull {
290   my $remote = shift || 'origin';
291
292   git ( 'fetch', $remote);
293
294   do_merge ();
295 }
296
297
298 sub do_merge {
299   insist_committed ();
300
301   my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1);
302
303   git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD');
304
305   git ( { GIT_WORK_TREE => $tempwork }, 'merge', 'FETCH_HEAD');
306
307   do_checkout ();
308 }
309
310
311 sub do_log {
312   # we don't want output trapping here, because we want the pager.
313   system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_);
314 }
315
316
317 sub do_push {
318   my $remote = shift || 'origin';
319
320   git ('push', $remote);
321 }
322
323
324 sub do_status {
325   my $status = compute_status ();
326
327   my %output = ();
328   foreach my $pair (@{$status->{added}}) {
329     $output{$pair->{id}} ||= {};
330     $output{$pair->{id}}{$pair->{tag}} = 'A'
331   }
332
333   foreach my $pair (@{$status->{deleted}}) {
334     $output{$pair->{id}} ||= {};
335     $output{$pair->{id}}{$pair->{tag}} = 'D'
336   }
337
338   foreach my $pair (@{$status->{missing}}) {
339     $output{$pair->{id}} ||= {};
340     $output{$pair->{id}}{$pair->{tag}} = 'U'
341   }
342
343   if (is_unmerged ()) {
344     foreach my $pair (diff_refs ('A')) {
345       $output{$pair->{id}} ||= {};
346       $output{$pair->{id}}{$pair->{tag}} ||= ' ';
347       $output{$pair->{id}}{$pair->{tag}} .= 'a';
348     }
349
350     foreach my $pair (diff_refs ('D')) {
351       $output{$pair->{id}} ||= {};
352       $output{$pair->{id}}{$pair->{tag}} ||= ' ';
353       $output{$pair->{id}}{$pair->{tag}} .= 'd';
354     }
355   }
356
357   foreach my $id (sort keys %output) {
358     foreach my $tag (sort keys %{$output{$id}}) {
359       printf "%s\t%s\t%s\n", $output{$id}{$tag}, $id, $tag;
360     }
361   }
362 }
363
364
365 sub is_unmerged {
366
367   return 0 if (! -f $NMBGIT.'/FETCH_HEAD');
368
369   my $fetch_head = git ('rev-parse', 'FETCH_HEAD');
370   my $base = git ( 'merge-base', 'HEAD', 'FETCH_HEAD');
371
372   return ($base ne $fetch_head);
373
374 }
375
376 sub compute_status {
377   my %args = @_;
378
379   my @added;
380   my @deleted;
381   my @missing;
382
383   my $index = index_tags ();
384
385   my @maybe_deleted = diff_index ($index, 'D');
386
387   foreach my $pair (@maybe_deleted) {
388
389     my $id = $pair->{id};
390
391     my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id")
392       or die "searching for $id";
393     if (!<$fh>) {
394       push @missing, $pair;
395     } else {
396       push @deleted, $pair;
397     }
398   }
399
400
401   @added = diff_index ($index, 'A');
402
403   unlink $index || die "unlink $index: $!";
404
405   return { added => [@added], deleted => [@deleted], missing => [@missing] };
406 }
407
408
409 sub diff_index {
410   my $index = shift;
411   my $filter = shift;
412
413   my $fh = git_pipe ({ GIT_INDEX_FILE => $index },
414                   qw/diff-index --cached/,
415                  "--diff-filter=$filter", qw/--name-only HEAD/ );
416
417   return unpack_diff_lines ($fh);
418 }
419
420
421 sub diff_refs {
422   my $filter = shift;
423   my $ref1 = shift || 'HEAD';
424   my $ref2 = shift || 'FETCH_HEAD';
425
426   my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only',
427                  $ref1, $ref2);
428
429   return unpack_diff_lines ($fh);
430 }
431
432
433 sub unpack_diff_lines {
434   my $fh = shift;
435
436   my @found;
437   while(<$fh>) {
438     chomp ();
439     my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x;
440
441     $id = decode_from_fs ($id);
442     $tag = decode_from_fs ($tag);
443
444     push @found, { id => $id, tag => $tag };
445   }
446
447   return @found;
448 }
449
450
451 sub encode_for_fs {
452   my $str = shift;
453
454   $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge;
455   return $str;
456 }
457
458
459 sub decode_from_fs {
460   my $str = shift;
461
462   $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg;
463
464   return $str;
465
466 }
467
468
469 sub usage {
470   pod2usage ();
471   exit (1);
472 }
473
474
475 sub do_help {
476   pod2usage ( -verbose => 2 );
477   exit (0);
478 }
479
480 __END__
481
482 =head1 NAME
483
484 nmbug - manage notmuch tags about notmuch
485
486 =head1 SYNOPSIS
487
488 nmbug subcommand [options]
489
490 B<nmbug help> for more help
491
492 =head1 OPTIONS
493
494 =head2 Most common commands
495
496 =over 8
497
498 =item B<commit> [message]
499
500 Commit appropriately prefixed tags from the notmuch database to
501 git. Any extra arguments are used (one per line) as a commit message.
502
503 =item  B<push> [remote]
504
505 push local nmbug git state to remote repo
506
507 =item  B<pull> [remote]
508
509 pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
510 B<fetch> followed by B<merge>.
511
512 =back
513
514 =head2 Other Useful Commands
515
516 =over 8
517
518 =item B<checkout>
519
520 Update the notmuch database from git. This is mainly useful to discard
521 your changes in notmuch relative to git.
522
523 =item B<fetch> [remote]
524
525 Fetch changes from the remote repo (see merge to bring those changes
526 into notmuch).
527
528 =item B<help> [subcommand]
529
530 print help [for subcommand]
531
532 =item B<log> [parameters]
533
534 A simple wrapper for git log. After running C<nmbug fetch>, you can
535 inspect the changes with C<nmbug log HEAD..FETCH_HEAD>
536
537 =item B<merge>
538
539 Merge changes from FETCH_HEAD into HEAD, and load the result into
540 notmuch.
541
542 =item  B<status>
543
544 Show pending updates in notmuch or git repo. See below for more
545 information about the output format.
546
547 =back
548
549 =head2 Less common commands
550
551 =over 8
552
553 =item B<archive>
554
555 Dump a tar archive (using git archive) of the current nmbug tag set.
556
557 =back
558
559 =head1 STATUS FORMAT
560
561 B<nmbug status> prints lines of the form
562
563    ng Message-Id tag
564
565 where n is a single character representing notmuch database status
566
567 =over 8
568
569 =item B<A>
570
571 Tag is present in notmuch database, but not committed to nmbug
572 (equivalently, tag has been deleted in nmbug repo, e.g. by a pull, but
573 not restored to notmuch database).
574
575 =item B<D>
576
577 Tag is present in nmbug repo, but not restored to notmuch database
578 (equivalently, tag has been deleted in notmuch)
579
580 =item B<U>
581
582 Message is unknown (missing from local notmuch database)
583
584 =back
585
586 The second character (if present) represents a difference between remote
587 git and local. Typically C<nmbug fetch> needs to be run to update this.
588
589 =over 8
590
591
592 =item B<a>
593
594 Tag is present in remote, but not in local git.
595
596
597 =item B<d>
598
599 Tag is present in local git, but not in remote git.
600
601
602 =back
603
604 =head1 DUMP FORMAT
605
606 Each tag $tag for message with Message-Id $id is written to
607 an empty file
608
609         tags/encode($id)/encode($tag)
610
611 The encoding preserves alphanumerics, and the characters "+-_@=.:,"
612 (not the quotes).  All other octets are replaced with '%' followed by
613 a two digit hex number.
614
615 =head1 ENVIRONMENT
616
617 B<NMBGIT> specifies the location of the git repository used by nmbug.
618 If not specified $HOME/.nmbug is used.
619
620 B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
621 interest to nmbug. If not specified 'notmuch::' is used.