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>);
70 die "'git @_' exited with nonzero value\n";
77 my $envref = (ref $_[0] eq 'HASH') ? shift : {};
78 my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef;
79 my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : '-|';
83 if (open my $child, $dir) {
87 while (my ($key, $value) = each %{$envref}) {
91 if (defined $ioref && $dir eq '-|') {
92 open my $fh, '|-', @_ or die "open |- @_: $!";
93 foreach my $line (@{$ioref}) {
94 print $fh $line, "\n";
99 open STDIN, '<', '/dev/null' or die "reopening stdin: $!"
111 my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*")
112 or die 'error dumping tags';
116 push @tags, $_ if (m/^$prefix/);
119 die "'notmuch search --output=tags *' exited with nonzero value\n";
126 system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD');
130 my $repository = shift;
132 my $tempwork = tempdir ('/tmp/nmbug-clone.XXXXXX', CLEANUP => 1);
133 system ('git', 'clone', '--no-checkout', '--separate-git-dir', $NMBGIT,
134 $repository, $tempwork) == 0
135 or die "'git clone' exited with nonzero value\n";
136 git ('config', '--unset', 'core.worktree');
141 return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0;
148 my $status = compute_status ();
150 if ( is_committed ($status) ) {
151 print "Nothing to commit\n";
155 my $index = read_tree ('HEAD');
157 update_index ($index, $status);
159 my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree')
160 or die 'no output from write-tree';
162 my $parent = git ( 'rev-parse', 'HEAD' )
163 or die 'no output from rev-parse';
165 my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent)
166 or die 'commit-tree';
168 git ('update-ref', 'HEAD', $commit);
170 unlink $index || die "unlink: $!";
176 my $index = $NMBGIT.'/nmbug.index';
177 git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty');
178 git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish);
186 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
187 '|-', qw/git update-index --index-info/)
188 or die 'git update-index';
190 foreach my $pair (@{$status->{deleted}}) {
191 index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag});
194 foreach my $pair (@{$status->{added}}) {
195 index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag});
197 unless (close $git) {
198 die "'git update-index --index-info' exited with nonzero value\n";
205 my $remote = shift || 'origin';
207 git ('fetch', $remote);
213 system ('notmuch', @args) == 0 or die "notmuch @args failed: $?";
219 my $index = $NMBGIT.'/nmbug.index';
221 my $query = join ' ', map ("tag:\"$_\"", get_tags ($TAGPREFIX));
223 my $fh = spawn ('-|', qw/notmuch dump --format=batch-tag --/, $query)
224 or die "notmuch dump: $!";
226 git ('read-tree', '--empty');
227 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
228 '|-', qw/git update-index --index-info/)
229 or die 'git update-index';
234 my ($rest,$id) = split(/ -- id:/);
236 if ($id =~ s/^"(.*)"\s*$/$1/) {
237 # xapian quoted string, dequote.
241 #strip prefixes from tags before writing
242 my @tags = grep { s/^[+]$ENCPREFIX//; } split (' ', $rest);
243 index_tags_for_msg ($git,$id, 'A', @tags);
245 unless (close $git) {
246 die "'git update-index --index-info' exited with nonzero value\n";
249 die "'notmuch dump --format=batch-tag -- $query' exited with nonzero value\n";
254 # update the git index to either create or delete an empty file.
255 # Neither argument should be encoded/escaped.
256 sub index_tags_for_msg {
261 my $hash = $EMPTYBLOB;
262 my $blobmode = '100644';
266 $hash = '0000000000000000000000000000000000000000';
269 foreach my $tag (@_) {
270 my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag);
271 print $fh "$blobmode $hash\t$tagpath\n";
277 do_sync (action => 'checkout');
280 sub quote_for_xapian {
283 return '"' . $str . '"';
286 sub pair_to_batch_line {
287 my ($action, $pair) = @_;
289 # the tag should already be suitably encoded
291 return $action . $ENCPREFIX . $pair->{tag} .
292 ' -- id:' . quote_for_xapian ($pair->{id})."\n";
299 my $status = compute_status ();
300 my ($A_action, $D_action);
302 if ($args{action} eq 'checkout') {
310 my $notmuch = spawn ({}, '|-', qw/notmuch tag --batch/)
311 or die 'notmuch tag --batch';
313 foreach my $pair (@{$status->{added}}) {
314 print $notmuch pair_to_batch_line ($A_action, $pair);
317 foreach my $pair (@{$status->{deleted}}) {
318 print $notmuch pair_to_batch_line ($D_action, $pair);
321 unless (close $notmuch) {
322 die "'notmuch tag --batch' exited with nonzero value\n";
327 sub insist_committed {
329 my $status=compute_status();
330 if ( !is_committed ($status) ) {
331 print "Uncommitted changes to $TAGPREFIX* tags in notmuch
333 For a summary of changes, run 'nmbug status'
334 To save your changes, run 'nmbug commit' before merging/pull
335 To discard your changes, run 'nmbug checkout'
344 my $remote = shift || 'origin';
345 my $branch = shift || 'master';
347 git ( 'fetch', $remote);
349 do_merge ("$remote/$branch");
354 my $commit = shift || '@{upstream}';
358 my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1);
360 git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD');
362 git ( { GIT_WORK_TREE => $tempwork }, 'merge', $commit);
369 # we don't want output trapping here, because we want the pager.
370 system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_);
375 my $remote = shift || 'origin';
377 git ('push', $remote, 'master');
382 my $status = compute_status ();
385 foreach my $pair (@{$status->{added}}) {
386 $output{$pair->{id}} ||= {};
387 $output{$pair->{id}}{$pair->{tag}} = 'A'
390 foreach my $pair (@{$status->{deleted}}) {
391 $output{$pair->{id}} ||= {};
392 $output{$pair->{id}}{$pair->{tag}} = 'D'
395 foreach my $pair (@{$status->{missing}}) {
396 $output{$pair->{id}} ||= {};
397 $output{$pair->{id}}{$pair->{tag}} = 'U'
400 if (is_unmerged ()) {
401 foreach my $pair (diff_refs ('A')) {
402 $output{$pair->{id}} ||= {};
403 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
404 $output{$pair->{id}}{$pair->{tag}} .= 'a';
407 foreach my $pair (diff_refs ('D')) {
408 $output{$pair->{id}} ||= {};
409 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
410 $output{$pair->{id}}{$pair->{tag}} .= 'd';
414 foreach my $id (sort keys %output) {
415 foreach my $tag (sort keys %{$output{$id}}) {
416 printf "%s\t%s\t%s\n", $output{$id}{$tag}, $id, $tag;
423 my $commit = shift || '@{upstream}';
425 my $fetch_head = git ('rev-parse', $commit);
426 my $base = git ( 'merge-base', 'HEAD', $commit);
428 return ($base ne $fetch_head);
439 my $index = index_tags ();
441 my @maybe_deleted = diff_index ($index, 'D');
443 foreach my $pair (@maybe_deleted) {
445 my $id = $pair->{id};
447 my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id")
448 or die "searching for $id";
450 push @missing, $pair;
452 push @deleted, $pair;
455 die "'notmuch search --output=files id:$id' exited with nonzero value\n";
460 @added = diff_index ($index, 'A');
462 unlink $index || die "unlink $index: $!";
464 return { added => [@added], deleted => [@deleted], missing => [@missing] };
472 my $fh = git_pipe ({ GIT_INDEX_FILE => $index },
473 qw/diff-index --cached/,
474 "--diff-filter=$filter", qw/--name-only HEAD/ );
476 my @lines = unpack_diff_lines ($fh);
478 die "'git diff-index --cached --diff-filter=$filter --name-only HEAD' ",
479 "exited with nonzero value\n";
487 my $ref1 = shift || 'HEAD';
488 my $ref2 = shift || '@{upstream}';
490 my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only',
493 my @lines = unpack_diff_lines ($fh);
495 die "'git diff --diff-filter=$filter --name-only $ref1 $ref2' ",
496 "exited with nonzero value\n";
502 sub unpack_diff_lines {
508 my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x;
510 $id = decode_from_fs ($id);
511 $tag = decode_from_fs ($tag);
513 push @found, { id => $id, tag => $tag };
523 $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge;
531 $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg;
545 pod2usage ( -verbose => 2 );
553 nmbug - manage notmuch tags about notmuch
557 nmbug subcommand [options]
559 B<nmbug help> for more help
563 =head2 Most common commands
567 =item B<commit> [message]
569 Commit appropriately prefixed tags from the notmuch database to
570 git. Any extra arguments are used (one per line) as a commit message.
572 =item B<push> [remote]
574 push local nmbug git state to remote repo
576 =item B<pull> [remote] [branch]
578 pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
579 B<fetch> followed by B<merge>. The default remote is C<origin>, and
580 the default branch is C<master>.
584 =head2 Other Useful Commands
588 =item B<clone> repository
590 Create a local nmbug repository from a remote source. This wraps
591 C<git clone>, adding some options to avoid creating a working tree
592 while preserving remote-tracking branches and upstreams.
596 Update the notmuch database from git. This is mainly useful to discard
597 your changes in notmuch relative to git.
599 =item B<fetch> [remote]
601 Fetch changes from the remote repo (see merge to bring those changes
604 =item B<help> [subcommand]
606 print help [for subcommand]
608 =item B<log> [parameters]
610 A simple wrapper for git log. After running C<nmbug fetch>, you can
611 inspect the changes with C<nmbug log HEAD..@{upstream}>
613 =item B<merge> [commit]
615 Merge changes from C<commit> into HEAD, and load the result into
616 notmuch. The default commit is C<@{upstream}>.
620 Show pending updates in notmuch or git repo. See below for more
621 information about the output format.
625 =head2 Less common commands
631 Dump a tar archive (using git archive) of the current nmbug tag set.
637 B<nmbug status> prints lines of the form
641 where n is a single character representing notmuch database status
647 Tag is present in notmuch database, but not committed to nmbug
648 (equivalently, tag has been deleted in nmbug repo, e.g. by a pull, but
649 not restored to notmuch database).
653 Tag is present in nmbug repo, but not restored to notmuch database
654 (equivalently, tag has been deleted in notmuch)
658 Message is unknown (missing from local notmuch database)
662 The second character (if present) represents a difference between remote
663 git and local. Typically C<nmbug fetch> needs to be run to update this.
670 Tag is present in remote, but not in local git.
675 Tag is present in local git, but not in remote git.
682 Each tag $tag for message with Message-Id $id is written to
685 tags/encode($id)/encode($tag)
687 The encoding preserves alphanumerics, and the characters "+-_@=.:,"
688 (not the quotes). All other octets are replaced with '%' followed by
689 a two digit hex number.
693 B<NMBGIT> specifies the location of the git repository used by nmbug.
694 If not specified $HOME/.nmbug is used.
696 B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
697 interest to nmbug. If not specified 'notmuch::' is used.