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 = $ENV{NMBPREFIX} || 'notmuch::';
19 my $EMPTYBLOB = 'e69de29bb2d1d6434b8b29ae775ad8c2e48c5391';
23 my $ESCAPE_CHAR = '%';
24 my $NO_ESCAPE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'.
26 my $MUST_ENCODE = qr{[^\Q$NO_ESCAPE\E]};
27 my $ESCAPED_RX = qr{$ESCAPE_CHAR([A-Fa-f0-9]{2})};
30 archive => \&do_archive,
31 checkout => \&do_checkout,
32 commit => \&do_commit,
39 status => \&do_status,
42 my $subcommand = shift || usage ();
44 if (!exists $command{$subcommand}) {
48 &{$command{$subcommand}}(@ARGV);
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;
56 $envref->{GIT_DIR} ||= $NMBGIT;
57 spawn ($envref, defined $ioref ? $ioref : (), defined $dir ? $dir : (), @_);
61 my $fh = git_pipe (@_);
62 my $str = join ('', <$fh>);
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 : '-|';
74 if (open my $child, $dir) {
78 while (my ($key, $value) = each %{$envref}) {
82 if (defined $ioref && $dir eq '-|') {
83 open my $fh, '|-', @_ or die "open |- @_: $!";
84 foreach my $line (@{$ioref}) {
85 print $fh $line, "\n";
90 open STDIN, '<', '/dev/null' or die "reopening stdin: $!"
102 my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*")
103 or die 'error dumping tags';
107 push @tags, $_ if (m/^$prefix/);
114 system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD');
120 return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0;
127 my $status = compute_status ();
129 if ( is_committed ($status) ) {
130 print "Nothing to commit\n";
134 my $index = read_tree ('HEAD');
136 update_index ($index, $status);
138 my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree')
139 or die 'no output from write-tree';
141 my $parent = git ( 'rev-parse', 'HEAD' )
142 or die 'no output from rev-parse';
144 my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent)
145 or die 'commit-tree';
147 git ('update-ref', 'HEAD', $commit);
149 unlink $index || die "unlink: $!";
155 my $index = $NMBGIT.'/nmbug.index';
156 git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty');
157 git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish);
165 my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
166 '|-', qw/git update-index --index-info/)
167 or die 'git update-index';
169 foreach my $pair (@{$status->{deleted}}) {
170 index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag});
173 foreach my $pair (@{$status->{added}}) {
174 index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag});
180 my $remote = shift || 'origin';
182 git ('fetch', $remote);
188 system ('notmuch', @args) == 0 or die "notmuch @args failed: $?";
194 my $index = $NMBGIT.'/nmbug.index';
196 my $query = join ' ', map ("tag:$_", get_tags ($TAGPREFIX));
198 my $fh = spawn ('-|', qw/notmuch dump --/, $query)
199 or die "notmuch dump: $!";
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';
207 m/ ( [^ ]* ) \s+ \( ([^\)]* ) \) /x || die 'syntax error in dump';
208 my ($id,$rest) = ($1,$2);
210 #strip prefixes before writing
211 my @tags = grep { s/^$TAGPREFIX//; } split (' ', $rest);
212 index_tags_for_msg ($git,$id, 'A', @tags);
219 sub index_tags_for_msg {
224 my $hash = $EMPTYBLOB;
225 my $blobmode = '100644';
229 $hash = '0000000000000000000000000000000000000000';
232 foreach my $tag (@_) {
233 my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag);
234 print $fh "$blobmode $hash\t$tagpath\n";
240 do_sync (action => 'checkout');
248 my $status = compute_status ();
249 my ($A_action, $D_action);
251 if ($args{action} eq 'checkout') {
259 foreach my $pair (@{$status->{added}}) {
261 notmuch ('tag', $A_action.$TAGPREFIX.$pair->{tag},
265 foreach my $pair (@{$status->{deleted}}) {
266 notmuch ('tag', $D_action.$TAGPREFIX.$pair->{tag},
273 sub insist_committed {
275 my $status=compute_status();
276 if ( !is_committed ($status) ) {
277 print "Uncommitted changes to $TAGPREFIX* tags in notmuch
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'
290 my $remote = shift || 'origin';
292 git ( 'fetch', $remote);
301 my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1);
303 git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD');
305 git ( { GIT_WORK_TREE => $tempwork }, 'merge', 'FETCH_HEAD');
312 # we don't want output trapping here, because we want the pager.
313 system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_);
318 my $remote = shift || 'origin';
320 git ('push', $remote);
325 my $status = compute_status ();
328 foreach my $pair (@{$status->{added}}) {
329 $output{$pair->{id}} ||= {};
330 $output{$pair->{id}}{$pair->{tag}} = 'A'
333 foreach my $pair (@{$status->{deleted}}) {
334 $output{$pair->{id}} ||= {};
335 $output{$pair->{id}}{$pair->{tag}} = 'D'
338 foreach my $pair (@{$status->{missing}}) {
339 $output{$pair->{id}} ||= {};
340 $output{$pair->{id}}{$pair->{tag}} = 'U'
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';
350 foreach my $pair (diff_refs ('D')) {
351 $output{$pair->{id}} ||= {};
352 $output{$pair->{id}}{$pair->{tag}} ||= ' ';
353 $output{$pair->{id}}{$pair->{tag}} .= 'd';
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;
367 return 0 if (! -f $NMBGIT.'/FETCH_HEAD');
369 my $fetch_head = git ('rev-parse', 'FETCH_HEAD');
370 my $base = git ( 'merge-base', 'HEAD', 'FETCH_HEAD');
372 return ($base ne $fetch_head);
383 my $index = index_tags ();
385 my @maybe_deleted = diff_index ($index, 'D');
387 foreach my $pair (@maybe_deleted) {
389 my $id = $pair->{id};
391 my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id")
392 or die "searching for $id";
394 push @missing, $pair;
396 push @deleted, $pair;
401 @added = diff_index ($index, 'A');
403 unlink $index || die "unlink $index: $!";
405 return { added => [@added], deleted => [@deleted], missing => [@missing] };
413 my $fh = git_pipe ({ GIT_INDEX_FILE => $index },
414 qw/diff-index --cached/,
415 "--diff-filter=$filter", qw/--name-only HEAD/ );
417 return unpack_diff_lines ($fh);
423 my $ref1 = shift || 'HEAD';
424 my $ref2 = shift || 'FETCH_HEAD';
426 my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only',
429 return unpack_diff_lines ($fh);
433 sub unpack_diff_lines {
439 my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x;
441 $id = decode_from_fs ($id);
442 $tag = decode_from_fs ($tag);
444 push @found, { id => $id, tag => $tag };
454 $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge;
462 $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg;
476 pod2usage ( -verbose => 2 );
484 nmbug - manage notmuch tags about notmuch
488 nmbug subcommand [options]
490 B<nmbug help> for more help
494 =head2 Most common commands
498 =item B<commit> [message]
500 Commit appropriately prefixed tags from the notmuch database to
501 git. Any extra arguments are used (one per line) as a commit message.
503 =item B<push> [remote]
505 push local nmbug git state to remote repo
507 =item B<pull> [remote]
509 pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
510 B<fetch> followed by B<merge>.
514 =head2 Other Useful Commands
520 Update the notmuch database from git. This is mainly useful to discard
521 your changes in notmuch relative to git.
523 =item B<fetch> [remote]
525 Fetch changes from the remote repo (see merge to bring those changes
528 =item B<help> [subcommand]
530 print help [for subcommand]
532 =item B<log> [parameters]
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>
539 Merge changes from FETCH_HEAD into HEAD, and load the result into
544 Show pending updates in notmuch or git repo. See below for more
545 information about the output format.
549 =head2 Less common commands
555 Dump a tar archive (using git archive) of the current nmbug tag set.
561 B<nmbug status> prints lines of the form
565 where n is a single character representing notmuch database status
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).
577 Tag is present in nmbug repo, but not restored to notmuch database
578 (equivalently, tag has been deleted in notmuch)
582 Message is unknown (missing from local notmuch database)
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.
594 Tag is present in remote, but not in local git.
599 Tag is present in local git, but not in remote git.
606 Each tag $tag for message with Message-Id $id is written to
609 tags/encode($id)/encode($tag)
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.
617 B<NMBGIT> specifies the location of the git repository used by nmbug.
618 If not specified $HOME/.nmbug is used.
620 B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
621 interest to nmbug. If not specified 'notmuch::' is used.