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,
30 commit => \&do_commit,
37 status => \&do_status,
40 # Convert prefix into form suitable for literal matching against
41 # notmuch dump --format=batch-tag output.
42 my $ENCPREFIX = encode_for_fs ($TAGPREFIX);
43 $ENCPREFIX =~ s/:/%3a/g;
45 my $subcommand = shift || usage ();
47 if (!exists $command{$subcommand}) {
52 my $EMPTYBLOB = git (qw{hash-object -t blob /dev/null});
54 &{$command{$subcommand}}(@ARGV);
57 my $envref = (ref $_[0] eq 'HASH') ? shift : {};
58 my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef;
59 my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : undef;
62 $envref->{GIT_DIR} ||= $NMBGIT;
63 spawn ($envref, defined $ioref ? $ioref : (), defined $dir ? $dir : (), @_);
67 my $fh = git_pipe (@_);
68 my $str = join ('', <$fh>);
72 return ($str, $status);
76 my ($str, $status) = git_with_status (@_);
78 die "'git @_' exited with nonzero value\n";
84 my $envref = (ref $_[0] eq 'HASH') ? shift : {};
85 my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef;
86 my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : '-|';
90 if (open my $child, $dir) {
94 while (my ($key, $value) = each %{$envref}) {
98 if (defined $ioref && $dir eq '-|') {
99 open my $fh, '|-', @_ or die "open |- @_: $!";
100 foreach my $line (@{$ioref}) {
101 print $fh $line, "\n";
106 open STDIN, '<', '/dev/null' or die "reopening stdin: $!"
118 my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*")
119 or die 'error dumping tags';
123 push @tags, $_ if (m/^$prefix/);
126 die "'notmuch search --output=tags *' exited with nonzero value\n";
133 system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD');
137 my $repository = shift;
139 my $tempwork = tempdir ('/tmp/nmbug-clone.XXXXXX', CLEANUP => 1);
140 system ('git', 'clone', '--no-checkout', '--separate-git-dir', $NMBGIT,
141 $repository, $tempwork) == 0
142 or die "'git clone' exited with nonzero value\n";
143 git ('config', '--unset', 'core.worktree');
144 git ('config', 'core.bare', 'true');
149 return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0;
156 my $status = compute_status ();
158 if ( is_committed ($status) ) {
159 print "Nothing to commit\n";
163 my $index = read_tree ('HEAD');
165 update_index ($index, $status);
167 my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree')
168 or die 'no output from write-tree';
170 my $parent = git ( 'rev-parse', 'HEAD' )
171 or die 'no output from rev-parse';
173 my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent)
174 or die 'commit-tree';
176 git ('update-ref', 'HEAD', $commit);
178 unlink $index || die "unlink: $!";
184 my $index = $NMBGIT.'/nmbug.index';
185 git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty');
186 git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish);
194 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
195 '|-', qw/git update-index --index-info/)
196 or die 'git update-index';
198 foreach my $pair (@{$status->{deleted}}) {
199 index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag});
202 foreach my $pair (@{$status->{added}}) {
203 index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag});
205 unless (close $git) {
206 die "'git update-index --index-info' exited with nonzero value\n";
213 my $remote = shift || 'origin';
215 git ('fetch', $remote);
221 system ('notmuch', @args) == 0 or die "notmuch @args failed: $?";
227 my $index = $NMBGIT.'/nmbug.index';
229 my $query = join ' ', map ("tag:\"$_\"", get_tags ($TAGPREFIX));
231 my $fh = spawn ('-|', qw/notmuch dump --format=batch-tag --/, $query)
232 or die "notmuch dump: $!";
234 git ('read-tree', '--empty');
235 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
236 '|-', qw/git update-index --index-info/)
237 or die 'git update-index';
242 my ($rest,$id) = split(/ -- id:/);
244 if ($id =~ s/^"(.*)"\s*$/$1/) {
245 # xapian quoted string, dequote.
249 #strip prefixes from tags before writing
250 my @tags = grep { s/^[+]$ENCPREFIX//; } split (' ', $rest);
251 index_tags_for_msg ($git,$id, 'A', @tags);
253 unless (close $git) {
254 die "'git update-index --index-info' exited with nonzero value\n";
257 die "'notmuch dump --format=batch-tag -- $query' exited with nonzero value\n";
262 # update the git index to either create or delete an empty file.
263 # Neither argument should be encoded/escaped.
264 sub index_tags_for_msg {
269 my $hash = $EMPTYBLOB;
270 my $blobmode = '100644';
274 $hash = '0000000000000000000000000000000000000000';
277 foreach my $tag (@_) {
278 my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag);
279 print $fh "$blobmode $hash\t$tagpath\n";
285 do_sync (action => 'checkout');
288 sub quote_for_xapian {
291 return '"' . $str . '"';
294 sub pair_to_batch_line {
295 my ($action, $pair) = @_;
297 # the tag should already be suitably encoded
299 return $action . $ENCPREFIX . $pair->{tag} .
300 ' -- id:' . quote_for_xapian ($pair->{id})."\n";
307 my $status = compute_status ();
308 my ($A_action, $D_action);
310 if ($args{action} eq 'checkout') {
318 my $notmuch = spawn ({}, '|-', qw/notmuch tag --batch/)
319 or die 'notmuch tag --batch';
321 foreach my $pair (@{$status->{added}}) {
322 print $notmuch pair_to_batch_line ($A_action, $pair);
325 foreach my $pair (@{$status->{deleted}}) {
326 print $notmuch pair_to_batch_line ($D_action, $pair);
329 unless (close $notmuch) {
330 die "'notmuch tag --batch' exited with nonzero value\n";
335 sub insist_committed {
337 my $status=compute_status();
338 if ( !is_committed ($status) ) {
339 print "Uncommitted changes to $TAGPREFIX* tags in notmuch
341 For a summary of changes, run 'nmbug status'
342 To save your changes, run 'nmbug commit' before merging/pull
343 To discard your changes, run 'nmbug checkout'
352 my $remote = shift || 'origin';
353 my $branch = shift || 'master';
355 git ( 'fetch', $remote);
357 do_merge ("$remote/$branch");
362 my $commit = shift || '@{upstream}';
366 my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1);
368 git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD');
370 git ( { GIT_WORK_TREE => $tempwork }, 'merge', $commit);
377 # we don't want output trapping here, because we want the pager.
378 system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_);
383 my $remote = shift || 'origin';
385 git ('push', $remote, 'master');
390 my $status = compute_status ();
393 foreach my $pair (@{$status->{added}}) {
394 $output{$pair->{id}} ||= {};
395 $output{$pair->{id}}{$pair->{tag}} = 'A'
398 foreach my $pair (@{$status->{deleted}}) {
399 $output{$pair->{id}} ||= {};
400 $output{$pair->{id}}{$pair->{tag}} = 'D'
403 foreach my $pair (@{$status->{missing}}) {
404 $output{$pair->{id}} ||= {};
405 $output{$pair->{id}}{$pair->{tag}} = 'U'
408 if (is_unmerged ()) {
409 foreach my $pair (diff_refs ('A')) {
410 $output{$pair->{id}} ||= {};
411 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
412 $output{$pair->{id}}{$pair->{tag}} .= 'a';
415 foreach my $pair (diff_refs ('D')) {
416 $output{$pair->{id}} ||= {};
417 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
418 $output{$pair->{id}}{$pair->{tag}} .= 'd';
422 foreach my $id (sort keys %output) {
423 foreach my $tag (sort keys %{$output{$id}}) {
424 printf "%s\t%s\t%s\n", $output{$id}{$tag}, $id, $tag;
431 my $commit = shift || '@{upstream}';
433 my $fetch_head = git ('rev-parse', $commit);
434 my $base = git ( 'merge-base', 'HEAD', $commit);
436 return ($base ne $fetch_head);
447 my $index = index_tags ();
449 my @maybe_deleted = diff_index ($index, 'D');
451 foreach my $pair (@maybe_deleted) {
453 my $id = $pair->{id};
455 my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id")
456 or die "searching for $id";
458 push @missing, $pair;
460 push @deleted, $pair;
463 die "'notmuch search --output=files id:$id' exited with nonzero value\n";
468 @added = diff_index ($index, 'A');
470 unlink $index || die "unlink $index: $!";
472 return { added => [@added], deleted => [@deleted], missing => [@missing] };
480 my $fh = git_pipe ({ GIT_INDEX_FILE => $index },
481 qw/diff-index --cached/,
482 "--diff-filter=$filter", qw/--name-only HEAD/ );
484 my @lines = unpack_diff_lines ($fh);
486 die "'git diff-index --cached --diff-filter=$filter --name-only HEAD' ",
487 "exited with nonzero value\n";
495 my $ref1 = shift || 'HEAD';
496 my $ref2 = shift || '@{upstream}';
498 my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only',
501 my @lines = unpack_diff_lines ($fh);
503 die "'git diff --diff-filter=$filter --name-only $ref1 $ref2' ",
504 "exited with nonzero value\n";
510 sub unpack_diff_lines {
516 my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x;
518 $id = decode_from_fs ($id);
519 $tag = decode_from_fs ($tag);
521 push @found, { id => $id, tag => $tag };
531 $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge;
539 $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg;
553 pod2usage ( -verbose => 2 );
561 nmbug - manage notmuch tags about notmuch
565 nmbug subcommand [options]
567 B<nmbug help> for more help
571 =head2 Most common commands
575 =item B<commit> [message]
577 Commit appropriately prefixed tags from the notmuch database to
578 git. Any extra arguments are used (one per line) as a commit message.
580 =item B<push> [remote]
582 push local nmbug git state to remote repo
584 =item B<pull> [remote] [branch]
586 pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
587 B<fetch> followed by B<merge>. The default remote is C<origin>, and
588 the default branch is C<master>.
592 =head2 Other Useful Commands
596 =item B<clone> repository
598 Create a local nmbug repository from a remote source. This wraps
599 C<git clone>, adding some options to avoid creating a working tree
600 while preserving remote-tracking branches and upstreams.
604 Update the notmuch database from git. This is mainly useful to discard
605 your changes in notmuch relative to git.
607 =item B<fetch> [remote]
609 Fetch changes from the remote repo (see merge to bring those changes
612 =item B<help> [subcommand]
614 print help [for subcommand]
616 =item B<log> [parameters]
618 A simple wrapper for git log. After running C<nmbug fetch>, you can
619 inspect the changes with C<nmbug log HEAD..@{upstream}>
621 =item B<merge> [commit]
623 Merge changes from C<commit> into HEAD, and load the result into
624 notmuch. The default commit is C<@{upstream}>.
628 Show pending updates in notmuch or git repo. See below for more
629 information about the output format.
633 =head2 Less common commands
639 Dump a tar archive (using git archive) of the current nmbug tag set.
645 B<nmbug status> prints lines of the form
649 where n is a single character representing notmuch database status
655 Tag is present in notmuch database, but not committed to nmbug
656 (equivalently, tag has been deleted in nmbug repo, e.g. by a pull, but
657 not restored to notmuch database).
661 Tag is present in nmbug repo, but not restored to notmuch database
662 (equivalently, tag has been deleted in notmuch)
666 Message is unknown (missing from local notmuch database)
670 The second character (if present) represents a difference between remote
671 git and local. Typically C<nmbug fetch> needs to be run to update this.
678 Tag is present in remote, but not in local git.
683 Tag is present in local git, but not in remote git.
690 Each tag $tag for message with Message-Id $id is written to
693 tags/encode($id)/encode($tag)
695 The encoding preserves alphanumerics, and the characters "+-_@=.:,"
696 (not the quotes). All other octets are replaced with '%' followed by
697 a two digit hex number.
701 B<NMBGIT> specifies the location of the git repository used by nmbug.
702 If not specified $HOME/.nmbug is used.
704 B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
705 interest to nmbug. If not specified 'notmuch::' is used.