]> git.notmuchmail.org Git - notmuch/blobdiff - devel/nmbug/nmbug
emacs: Add new option notmuch-search-hide-excluded
[notmuch] / devel / nmbug / nmbug
diff --git a/devel/nmbug/nmbug b/devel/nmbug/nmbug
deleted file mode 100755 (executable)
index 998ee6b..0000000
+++ /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<nmbug help> for more help
-
-=head1 OPTIONS
-
-=head2 Most common commands
-
-=over 8
-
-=item B<commit> [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<push> [remote]
-
-push local nmbug git state to remote repo
-
-=item  B<pull> [remote] [branch]
-
-pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
-B<fetch> followed by B<merge>.  The default remote is C<origin>, and
-the default branch is C<master>.
-
-=back
-
-=head2 Other Useful Commands
-
-=over 8
-
-=item B<clone> repository
-
-Create a local nmbug repository from a remote source.  This wraps
-C<git clone>, adding some options to avoid creating a working tree
-while preserving remote-tracking branches and upstreams.
-
-=item B<checkout>
-
-Update the notmuch database from git. This is mainly useful to discard
-your changes in notmuch relative to git.
-
-=item B<fetch> [remote]
-
-Fetch changes from the remote repo (see merge to bring those changes
-into notmuch).
-
-=item B<help> [subcommand]
-
-print help [for subcommand]
-
-=item B<log> [parameters]
-
-A simple wrapper for git log. After running C<nmbug fetch>, you can
-inspect the changes with C<nmbug log HEAD..@{upstream}>
-
-=item B<merge> [commit]
-
-Merge changes from C<commit> into HEAD, and load the result into
-notmuch.  The default commit is C<@{upstream}>.
-
-=item  B<status>
-
-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<archive>
-
-Dump a tar archive (using git archive) of the current nmbug tag set.
-
-=back
-
-=head1 STATUS FORMAT
-
-B<nmbug status> prints lines of the form
-
-   ng Message-Id tag
-
-where n is a single character representing notmuch database status
-
-=over 8
-
-=item B<A>
-
-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<D>
-
-Tag is present in nmbug repo, but not restored to notmuch database
-(equivalently, tag has been deleted in notmuch)
-
-=item B<U>
-
-Message is unknown (missing from local notmuch database)
-
-=back
-
-The second character (if present) represents a difference between remote
-git and local. Typically C<nmbug fetch> needs to be run to update this.
-
-=over 8
-
-
-=item B<a>
-
-Tag is present in remote, but not in local git.
-
-
-=item B<d>
-
-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<NMBGIT> specifies the location of the git repository used by nmbug.
-If not specified $HOME/.nmbug is used.
-
-B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
-interest to nmbug. If not specified 'notmuch::' is used.