2 # Copyright (c) 2011 David Bremner
3 # License: same as notmuch
7 use File::Temp qw(tempdir);
12 my $NMBGIT = $ENV{NMBGIT} || $ENV{HOME}.'/.nmbug';
14 $NMBGIT .= '/.git' if (-d $NMBGIT.'/.git');
16 my $TAGPREFIX = defined($ENV{NMBPREFIX}) ? $ENV{NMBPREFIX} : 'notmuch::';
20 my $ESCAPE_CHAR = '%';
21 my $NO_ESCAPE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'.
23 my $MUST_ENCODE = qr{[^\Q$NO_ESCAPE\E]};
24 my $ESCAPED_RX = qr{$ESCAPE_CHAR([A-Fa-f0-9]{2})};
27 archive => \&do_archive,
28 checkout => \&do_checkout,
29 commit => \&do_commit,
36 status => \&do_status,
39 # Convert prefix into form suitable for literal matching against
40 # notmuch dump --format=batch-tag output.
41 my $ENCPREFIX = encode_for_fs ($TAGPREFIX);
42 $ENCPREFIX =~ s/:/%3a/g;
44 my $subcommand = shift || usage ();
46 if (!exists $command{$subcommand}) {
51 my $EMPTYBLOB = git (qw{hash-object -t blob /dev/null});
53 &{$command{$subcommand}}(@ARGV);
56 my $envref = (ref $_[0] eq 'HASH') ? shift : {};
57 my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef;
58 my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : undef;
61 $envref->{GIT_DIR} ||= $NMBGIT;
62 spawn ($envref, defined $ioref ? $ioref : (), defined $dir ? $dir : (), @_);
66 my $fh = git_pipe (@_);
67 my $str = join ('', <$fh>);
69 die "'git @_' exited with nonzero value\n";
76 my $envref = (ref $_[0] eq 'HASH') ? shift : {};
77 my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef;
78 my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : '-|';
82 if (open my $child, $dir) {
86 while (my ($key, $value) = each %{$envref}) {
90 if (defined $ioref && $dir eq '-|') {
91 open my $fh, '|-', @_ or die "open |- @_: $!";
92 foreach my $line (@{$ioref}) {
93 print $fh $line, "\n";
98 open STDIN, '<', '/dev/null' or die "reopening stdin: $!"
110 my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*")
111 or die 'error dumping tags';
115 push @tags, $_ if (m/^$prefix/);
118 die "'notmuch search --output=tags *' exited with nonzero value\n";
125 system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD');
131 return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0;
138 my $status = compute_status ();
140 if ( is_committed ($status) ) {
141 print "Nothing to commit\n";
145 my $index = read_tree ('HEAD');
147 update_index ($index, $status);
149 my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree')
150 or die 'no output from write-tree';
152 my $parent = git ( 'rev-parse', 'HEAD' )
153 or die 'no output from rev-parse';
155 my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent)
156 or die 'commit-tree';
158 git ('update-ref', 'HEAD', $commit);
160 unlink $index || die "unlink: $!";
166 my $index = $NMBGIT.'/nmbug.index';
167 git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty');
168 git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish);
176 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
177 '|-', qw/git update-index --index-info/)
178 or die 'git update-index';
180 foreach my $pair (@{$status->{deleted}}) {
181 index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag});
184 foreach my $pair (@{$status->{added}}) {
185 index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag});
187 unless (close $git) {
188 die "'git update-index --index-info' exited with nonzero value\n";
195 my $remote = shift || 'origin';
197 git ('fetch', $remote);
203 system ('notmuch', @args) == 0 or die "notmuch @args failed: $?";
209 my $index = $NMBGIT.'/nmbug.index';
211 my $query = join ' ', map ("tag:\"$_\"", get_tags ($TAGPREFIX));
213 my $fh = spawn ('-|', qw/notmuch dump --format=batch-tag --/, $query)
214 or die "notmuch dump: $!";
216 git ('read-tree', '--empty');
217 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
218 '|-', qw/git update-index --index-info/)
219 or die 'git update-index';
224 my ($rest,$id) = split(/ -- id:/);
226 if ($id =~ s/^"(.*)"\s*$/$1/) {
227 # xapian quoted string, dequote.
231 #strip prefixes from tags before writing
232 my @tags = grep { s/^[+]$ENCPREFIX//; } split (' ', $rest);
233 index_tags_for_msg ($git,$id, 'A', @tags);
235 unless (close $git) {
236 die "'git update-index --index-info' exited with nonzero value\n";
239 die "'notmuch dump --format=batch-tag -- $query' exited with nonzero value\n";
244 # update the git index to either create or delete an empty file.
245 # Neither argument should be encoded/escaped.
246 sub index_tags_for_msg {
251 my $hash = $EMPTYBLOB;
252 my $blobmode = '100644';
256 $hash = '0000000000000000000000000000000000000000';
259 foreach my $tag (@_) {
260 my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag);
261 print $fh "$blobmode $hash\t$tagpath\n";
267 do_sync (action => 'checkout');
270 sub quote_for_xapian {
273 return '"' . $str . '"';
276 sub pair_to_batch_line {
277 my ($action, $pair) = @_;
279 # the tag should already be suitably encoded
281 return $action . $ENCPREFIX . $pair->{tag} .
282 ' -- id:' . quote_for_xapian ($pair->{id})."\n";
289 my $status = compute_status ();
290 my ($A_action, $D_action);
292 if ($args{action} eq 'checkout') {
300 my $notmuch = spawn ({}, '|-', qw/notmuch tag --batch/)
301 or die 'notmuch tag --batch';
303 foreach my $pair (@{$status->{added}}) {
304 print $notmuch pair_to_batch_line ($A_action, $pair);
307 foreach my $pair (@{$status->{deleted}}) {
308 print $notmuch pair_to_batch_line ($D_action, $pair);
311 unless (close $notmuch) {
312 die "'notmuch tag --batch' exited with nonzero value\n";
317 sub insist_committed {
319 my $status=compute_status();
320 if ( !is_committed ($status) ) {
321 print "Uncommitted changes to $TAGPREFIX* tags in notmuch
323 For a summary of changes, run 'nmbug status'
324 To save your changes, run 'nmbug commit' before merging/pull
325 To discard your changes, run 'nmbug checkout'
334 my $remote = shift || 'origin';
336 git ( 'fetch', $remote);
345 my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1);
347 git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD');
349 git ( { GIT_WORK_TREE => $tempwork }, 'merge', 'FETCH_HEAD');
356 # we don't want output trapping here, because we want the pager.
357 system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_);
362 my $remote = shift || 'origin';
364 git ('push', $remote, 'master');
369 my $status = compute_status ();
372 foreach my $pair (@{$status->{added}}) {
373 $output{$pair->{id}} ||= {};
374 $output{$pair->{id}}{$pair->{tag}} = 'A'
377 foreach my $pair (@{$status->{deleted}}) {
378 $output{$pair->{id}} ||= {};
379 $output{$pair->{id}}{$pair->{tag}} = 'D'
382 foreach my $pair (@{$status->{missing}}) {
383 $output{$pair->{id}} ||= {};
384 $output{$pair->{id}}{$pair->{tag}} = 'U'
387 if (is_unmerged ()) {
388 foreach my $pair (diff_refs ('A')) {
389 $output{$pair->{id}} ||= {};
390 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
391 $output{$pair->{id}}{$pair->{tag}} .= 'a';
394 foreach my $pair (diff_refs ('D')) {
395 $output{$pair->{id}} ||= {};
396 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
397 $output{$pair->{id}}{$pair->{tag}} .= 'd';
401 foreach my $id (sort keys %output) {
402 foreach my $tag (sort keys %{$output{$id}}) {
403 printf "%s\t%s\t%s\n", $output{$id}{$tag}, $id, $tag;
411 return 0 if (! -f $NMBGIT.'/FETCH_HEAD');
413 my $fetch_head = git ('rev-parse', 'FETCH_HEAD');
414 my $base = git ( 'merge-base', 'HEAD', 'FETCH_HEAD');
416 return ($base ne $fetch_head);
427 my $index = index_tags ();
429 my @maybe_deleted = diff_index ($index, 'D');
431 foreach my $pair (@maybe_deleted) {
433 my $id = $pair->{id};
435 my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id")
436 or die "searching for $id";
438 push @missing, $pair;
440 push @deleted, $pair;
443 die "'notmuch search --output=files id:$id' exited with nonzero value\n";
448 @added = diff_index ($index, 'A');
450 unlink $index || die "unlink $index: $!";
452 return { added => [@added], deleted => [@deleted], missing => [@missing] };
460 my $fh = git_pipe ({ GIT_INDEX_FILE => $index },
461 qw/diff-index --cached/,
462 "--diff-filter=$filter", qw/--name-only HEAD/ );
464 my @lines = unpack_diff_lines ($fh);
466 die "'git diff-index --cached --diff-filter=$filter --name-only HEAD' ",
467 "exited with nonzero value\n";
475 my $ref1 = shift || 'HEAD';
476 my $ref2 = shift || 'FETCH_HEAD';
478 my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only',
481 my @lines = unpack_diff_lines ($fh);
483 die "'git diff --diff-filter=$filter --name-only $ref1 $ref2' ",
484 "exited with nonzero value\n";
490 sub unpack_diff_lines {
496 my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x;
498 $id = decode_from_fs ($id);
499 $tag = decode_from_fs ($tag);
501 push @found, { id => $id, tag => $tag };
511 $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge;
519 $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg;
533 pod2usage ( -verbose => 2 );
541 nmbug - manage notmuch tags about notmuch
545 nmbug subcommand [options]
547 B<nmbug help> for more help
551 =head2 Most common commands
555 =item B<commit> [message]
557 Commit appropriately prefixed tags from the notmuch database to
558 git. Any extra arguments are used (one per line) as a commit message.
560 =item B<push> [remote]
562 push local nmbug git state to remote repo
564 =item B<pull> [remote]
566 pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
567 B<fetch> followed by B<merge>.
571 =head2 Other Useful Commands
577 Update the notmuch database from git. This is mainly useful to discard
578 your changes in notmuch relative to git.
580 =item B<fetch> [remote]
582 Fetch changes from the remote repo (see merge to bring those changes
585 =item B<help> [subcommand]
587 print help [for subcommand]
589 =item B<log> [parameters]
591 A simple wrapper for git log. After running C<nmbug fetch>, you can
592 inspect the changes with C<nmbug log HEAD..FETCH_HEAD>
596 Merge changes from FETCH_HEAD into HEAD, and load the result into
601 Show pending updates in notmuch or git repo. See below for more
602 information about the output format.
606 =head2 Less common commands
612 Dump a tar archive (using git archive) of the current nmbug tag set.
618 B<nmbug status> prints lines of the form
622 where n is a single character representing notmuch database status
628 Tag is present in notmuch database, but not committed to nmbug
629 (equivalently, tag has been deleted in nmbug repo, e.g. by a pull, but
630 not restored to notmuch database).
634 Tag is present in nmbug repo, but not restored to notmuch database
635 (equivalently, tag has been deleted in notmuch)
639 Message is unknown (missing from local notmuch database)
643 The second character (if present) represents a difference between remote
644 git and local. Typically C<nmbug fetch> needs to be run to update this.
651 Tag is present in remote, but not in local git.
656 Tag is present in local git, but not in remote git.
663 Each tag $tag for message with Message-Id $id is written to
666 tags/encode($id)/encode($tag)
668 The encoding preserves alphanumerics, and the characters "+-_@=.:,"
669 (not the quotes). All other octets are replaced with '%' followed by
670 a two digit hex number.
674 B<NMBGIT> specifies the location of the git repository used by nmbug.
675 If not specified $HOME/.nmbug is used.
677 B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
678 interest to nmbug. If not specified 'notmuch::' is used.