X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=devel%2Fnmbug%2Fnmbug;h=043c186369c1f55fce114b230746f138d7bc2345;hp=998ee6b4b0d083467617dff92c1eab78132ce2d3;hb=HEAD;hpb=f92342cb76fa3e1fa2f1c2e727f8ddf1a5c21b7d diff --git a/devel/nmbug/nmbug b/devel/nmbug/nmbug deleted file mode 100755 index 998ee6b4..00000000 --- a/devel/nmbug/nmbug +++ /dev/null @@ -1,708 +0,0 @@ -#!/usr/bin/env perl -# Copyright (c) 2011 David Bremner -# License: same as notmuch - -use strict; -use warnings; -use File::Temp qw(tempdir); -use Pod::Usage; - -no encoding; - -my $NMBGIT = $ENV{NMBGIT} || $ENV{HOME}.'/.nmbug'; - -$NMBGIT .= '/.git' if (-d $NMBGIT.'/.git'); - -my $TAGPREFIX = defined($ENV{NMBPREFIX}) ? $ENV{NMBPREFIX} : 'notmuch::'; - -# for encoding - -my $ESCAPE_CHAR = '%'; -my $NO_ESCAPE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'. - '0123456789+-_@=.:,'; -my $MUST_ENCODE = qr{[^\Q$NO_ESCAPE\E]}; -my $ESCAPED_RX = qr{$ESCAPE_CHAR([A-Fa-f0-9]{2})}; - -my %command = ( - archive => \&do_archive, - checkout => \&do_checkout, - clone => \&do_clone, - commit => \&do_commit, - fetch => \&do_fetch, - help => \&do_help, - log => \&do_log, - merge => \&do_merge, - pull => \&do_pull, - push => \&do_push, - status => \&do_status, - ); - -# Convert prefix into form suitable for literal matching against -# notmuch dump --format=batch-tag output. -my $ENCPREFIX = encode_for_fs ($TAGPREFIX); -$ENCPREFIX =~ s/:/%3a/g; - -my $subcommand = shift || usage (); - -if (!exists $command{$subcommand}) { - usage (); -} - -# magic hash for git -my $EMPTYBLOB = git (qw{hash-object -t blob /dev/null}); - -&{$command{$subcommand}}(@ARGV); - -sub git_pipe { - my $envref = (ref $_[0] eq 'HASH') ? shift : {}; - my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef; - my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : undef; - - unshift @_, 'git'; - $envref->{GIT_DIR} ||= $NMBGIT; - spawn ($envref, defined $ioref ? $ioref : (), defined $dir ? $dir : (), @_); -} - -sub git_with_status { - my $fh = git_pipe (@_); - my $str = join ('', <$fh>); - close $fh; - my $status = $?; - chomp($str); - return ($str, $status); -} - -sub git { - my ($str, $status) = git_with_status (@_); - if ($status) { - die "'git @_' exited with nonzero value\n"; - } - return $str; -} - -sub spawn { - my $envref = (ref $_[0] eq 'HASH') ? shift : {}; - my $ioref = (ref $_[0] eq 'ARRAY') ? shift : undef; - my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : '-|'; - - die unless @_; - - if (open my $child, $dir) { - return $child; - } - # child - while (my ($key, $value) = each %{$envref}) { - $ENV{$key} = $value; - } - - if (defined $ioref && $dir eq '-|') { - open my $fh, '|-', @_ or die "open |- @_: $!"; - foreach my $line (@{$ioref}) { - print $fh $line, "\n"; - } - exit ! close $fh; - } else { - if ($dir ne '|-') { - open STDIN, '<', '/dev/null' or die "reopening stdin: $!" - } - exec @_; - die "exec @_: $!"; - } -} - - -sub get_tags { - my $prefix = shift; - my @tags; - - my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*") - or die 'error dumping tags'; - - while (<$fh>) { - chomp (); - push @tags, $_ if (m/^$prefix/); - } - unless (close $fh) { - die "'notmuch search --output=tags *' exited with nonzero value\n"; - } - return @tags; -} - - -sub do_archive { - system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD'); -} - -sub do_clone { - my $repository = shift; - - my $tempwork = tempdir ('/tmp/nmbug-clone.XXXXXX', CLEANUP => 1); - system ('git', 'clone', '--no-checkout', '--separate-git-dir', $NMBGIT, - $repository, $tempwork) == 0 - or die "'git clone' exited with nonzero value\n"; - git ('config', '--unset', 'core.worktree'); - git ('config', 'core.bare', 'true'); -} - -sub is_committed { - my $status = shift; - return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0; -} - - -sub do_commit { - my @args = @_; - - my $status = compute_status (); - - if ( is_committed ($status) ) { - print "Nothing to commit\n"; - return; - } - - my $index = read_tree ('HEAD'); - - update_index ($index, $status); - - my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree') - or die 'no output from write-tree'; - - my $parent = git ( 'rev-parse', 'HEAD' ) - or die 'no output from rev-parse'; - - my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent) - or die 'commit-tree'; - - git ('update-ref', 'HEAD', $commit); - - unlink $index || die "unlink: $!"; - -} - -sub read_tree { - my $treeish = shift; - my $index = $NMBGIT.'/nmbug.index'; - git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty'); - git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish); - return $index; -} - -sub update_index { - my $index = shift; - my $status = shift; - - my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index }, - '|-', qw/git update-index --index-info/) - or die 'git update-index'; - - foreach my $pair (@{$status->{deleted}}) { - index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag}); - } - - foreach my $pair (@{$status->{added}}) { - index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag}); - } - unless (close $git) { - die "'git update-index --index-info' exited with nonzero value\n"; - } - -} - - -sub do_fetch { - my $remote = shift || 'origin'; - - git ('fetch', $remote); -} - - -sub notmuch { - my @args = @_; - system ('notmuch', @args) == 0 or die "notmuch @args failed: $?"; -} - - -sub index_tags { - - my $index = $NMBGIT.'/nmbug.index'; - - my $query = join ' ', map ("tag:\"$_\"", get_tags ($TAGPREFIX)); - - my $fh = spawn ('-|', qw/notmuch dump --format=batch-tag --/, $query) - or die "notmuch dump: $!"; - - git ('read-tree', '--empty'); - my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index }, - '|-', qw/git update-index --index-info/) - or die 'git update-index'; - - while (<$fh>) { - - chomp(); - my ($rest,$id) = split(/ -- id:/); - - if ($id =~ s/^"(.*)"\s*$/$1/) { - # xapian quoted string, dequote. - $id =~ s/""/"/g; - } - - #strip prefixes from tags before writing - my @tags = grep { s/^[+]$ENCPREFIX//; } split (' ', $rest); - index_tags_for_msg ($git,$id, 'A', @tags); - } - unless (close $git) { - die "'git update-index --index-info' exited with nonzero value\n"; - } - unless (close $fh) { - die "'notmuch dump --format=batch-tag -- $query' exited with nonzero value\n"; - } - return $index; -} - -# update the git index to either create or delete an empty file. -# Neither argument should be encoded/escaped. -sub index_tags_for_msg { - my $fh = shift; - my $msgid = shift; - my $mode = shift; - - my $hash = $EMPTYBLOB; - my $blobmode = '100644'; - - if ($mode eq 'D') { - $blobmode = '0'; - $hash = '0000000000000000000000000000000000000000'; - } - - foreach my $tag (@_) { - my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag); - print $fh "$blobmode $hash\t$tagpath\n"; - } -} - - -sub do_checkout { - do_sync (action => 'checkout'); -} - -sub quote_for_xapian { - my $str = shift; - $str =~ s/"/""/g; - return '"' . $str . '"'; -} - -sub pair_to_batch_line { - my ($action, $pair) = @_; - - # the tag should already be suitably encoded - - return $action . $ENCPREFIX . $pair->{tag} . - ' -- id:' . quote_for_xapian ($pair->{id})."\n"; -} - -sub do_sync { - - my %args = @_; - - my $status = compute_status (); - my ($A_action, $D_action); - - if ($args{action} eq 'checkout') { - $A_action = '-'; - $D_action = '+'; - } else { - $A_action = '+'; - $D_action = '-'; - } - - my $notmuch = spawn ({}, '|-', qw/notmuch tag --batch/) - or die 'notmuch tag --batch'; - - foreach my $pair (@{$status->{added}}) { - print $notmuch pair_to_batch_line ($A_action, $pair); - } - - foreach my $pair (@{$status->{deleted}}) { - print $notmuch pair_to_batch_line ($D_action, $pair); - } - - unless (close $notmuch) { - die "'notmuch tag --batch' exited with nonzero value\n"; - } -} - - -sub insist_committed { - - my $status=compute_status(); - if ( !is_committed ($status) ) { - print "Uncommitted changes to $TAGPREFIX* tags in notmuch - -For a summary of changes, run 'nmbug status' -To save your changes, run 'nmbug commit' before merging/pull -To discard your changes, run 'nmbug checkout' -"; - exit (1); - } - -} - - -sub do_pull { - my $remote = shift || 'origin'; - my $branch = shift || 'master'; - - git ( 'fetch', $remote); - - do_merge ("$remote/$branch"); -} - - -sub do_merge { - my $commit = shift || '@{upstream}'; - - insist_committed (); - - my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1); - - git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD'); - - git ( { GIT_WORK_TREE => $tempwork }, 'merge', $commit); - - do_checkout (); -} - - -sub do_log { - # we don't want output trapping here, because we want the pager. - system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_); -} - - -sub do_push { - my $remote = shift || 'origin'; - - git ('push', $remote, 'master'); -} - - -sub do_status { - my $status = compute_status (); - - my %output = (); - foreach my $pair (@{$status->{added}}) { - $output{$pair->{id}} ||= {}; - $output{$pair->{id}}{$pair->{tag}} = 'A' - } - - foreach my $pair (@{$status->{deleted}}) { - $output{$pair->{id}} ||= {}; - $output{$pair->{id}}{$pair->{tag}} = 'D' - } - - foreach my $pair (@{$status->{missing}}) { - $output{$pair->{id}} ||= {}; - $output{$pair->{id}}{$pair->{tag}} = 'U' - } - - if (is_unmerged ()) { - foreach my $pair (diff_refs ('A')) { - $output{$pair->{id}} ||= {}; - $output{$pair->{id}}{$pair->{tag}} ||= ' '; - $output{$pair->{id}}{$pair->{tag}} .= 'a'; - } - - foreach my $pair (diff_refs ('D')) { - $output{$pair->{id}} ||= {}; - $output{$pair->{id}}{$pair->{tag}} ||= ' '; - $output{$pair->{id}}{$pair->{tag}} .= 'd'; - } - } - - foreach my $id (sort keys %output) { - foreach my $tag (sort keys %{$output{$id}}) { - printf "%s\t%s\t%s\n", $output{$id}{$tag}, $id, $tag; - } - } -} - - -sub is_unmerged { - my $commit = shift || '@{upstream}'; - - my ($fetch_head, $status) = git_with_status ('rev-parse', $commit); - if ($status) { - return 0; - } - my $base = git ( 'merge-base', 'HEAD', $commit); - - return ($base ne $fetch_head); - -} - -sub compute_status { - my %args = @_; - - my @added; - my @deleted; - my @missing; - - my $index = index_tags (); - - my @maybe_deleted = diff_index ($index, 'D'); - - foreach my $pair (@maybe_deleted) { - - my $id = $pair->{id}; - - my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id") - or die "searching for $id"; - if (!<$fh>) { - push @missing, $pair; - } else { - push @deleted, $pair; - } - unless (close $fh) { - die "'notmuch search --output=files id:$id' exited with nonzero value\n"; - } - } - - - @added = diff_index ($index, 'A'); - - unlink $index || die "unlink $index: $!"; - - return { added => [@added], deleted => [@deleted], missing => [@missing] }; -} - - -sub diff_index { - my $index = shift; - my $filter = shift; - - my $fh = git_pipe ({ GIT_INDEX_FILE => $index }, - qw/diff-index --cached/, - "--diff-filter=$filter", qw/--name-only HEAD/ ); - - my @lines = unpack_diff_lines ($fh); - unless (close $fh) { - die "'git diff-index --cached --diff-filter=$filter --name-only HEAD' ", - "exited with nonzero value\n"; - } - return @lines; -} - - -sub diff_refs { - my $filter = shift; - my $ref1 = shift || 'HEAD'; - my $ref2 = shift || '@{upstream}'; - - my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only', - $ref1, $ref2); - - my @lines = unpack_diff_lines ($fh); - unless (close $fh) { - die "'git diff --diff-filter=$filter --name-only $ref1 $ref2' ", - "exited with nonzero value\n"; - } - return @lines; -} - - -sub unpack_diff_lines { - my $fh = shift; - - my @found; - while(<$fh>) { - chomp (); - my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x; - - $id = decode_from_fs ($id); - $tag = decode_from_fs ($tag); - - push @found, { id => $id, tag => $tag }; - } - - return @found; -} - - -sub encode_for_fs { - my $str = shift; - - $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge; - return $str; -} - - -sub decode_from_fs { - my $str = shift; - - $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg; - - return $str; - -} - - -sub usage { - pod2usage (); - exit (1); -} - - -sub do_help { - pod2usage ( -verbose => 2 ); - exit (0); -} - -__END__ - -=head1 NAME - -nmbug - manage notmuch tags about notmuch - -=head1 SYNOPSIS - -nmbug subcommand [options] - -B for more help - -=head1 OPTIONS - -=head2 Most common commands - -=over 8 - -=item B [message] - -Commit appropriately prefixed tags from the notmuch database to -git. Any extra arguments are used (one per line) as a commit message. - -=item B [remote] - -push local nmbug git state to remote repo - -=item B [remote] [branch] - -pull (merge) remote repo changes to notmuch. B is equivalent to -B followed by B. The default remote is C, and -the default branch is C. - -=back - -=head2 Other Useful Commands - -=over 8 - -=item B repository - -Create a local nmbug repository from a remote source. This wraps -C, adding some options to avoid creating a working tree -while preserving remote-tracking branches and upstreams. - -=item B - -Update the notmuch database from git. This is mainly useful to discard -your changes in notmuch relative to git. - -=item B [remote] - -Fetch changes from the remote repo (see merge to bring those changes -into notmuch). - -=item B [subcommand] - -print help [for subcommand] - -=item B [parameters] - -A simple wrapper for git log. After running C, you can -inspect the changes with C - -=item B [commit] - -Merge changes from C into HEAD, and load the result into -notmuch. The default commit is C<@{upstream}>. - -=item B - -Show pending updates in notmuch or git repo. See below for more -information about the output format. - -=back - -=head2 Less common commands - -=over 8 - -=item B - -Dump a tar archive (using git archive) of the current nmbug tag set. - -=back - -=head1 STATUS FORMAT - -B prints lines of the form - - ng Message-Id tag - -where n is a single character representing notmuch database status - -=over 8 - -=item B - -Tag is present in notmuch database, but not committed to nmbug -(equivalently, tag has been deleted in nmbug repo, e.g. by a pull, but -not restored to notmuch database). - -=item B - -Tag is present in nmbug repo, but not restored to notmuch database -(equivalently, tag has been deleted in notmuch) - -=item B - -Message is unknown (missing from local notmuch database) - -=back - -The second character (if present) represents a difference between remote -git and local. Typically C needs to be run to update this. - -=over 8 - - -=item B - -Tag is present in remote, but not in local git. - - -=item B - -Tag is present in local git, but not in remote git. - - -=back - -=head1 DUMP FORMAT - -Each tag $tag for message with Message-Id $id is written to -an empty file - - tags/encode($id)/encode($tag) - -The encoding preserves alphanumerics, and the characters "+-_@=.:," -(not the quotes). All other octets are replaced with '%' followed by -a two digit hex number. - -=head1 ENVIRONMENT - -B specifies the location of the git repository used by nmbug. -If not specified $HOME/.nmbug is used. - -B specifies the prefix in the notmuch database for tags of -interest to nmbug. If not specified 'notmuch::' is used.