#!/usr/bin/perl

# notmuch-slurp-debbug -- add messages from a Debian bug to notmuch

# Copyright (C) 2018-2020 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.

use strict;
use warnings;

use Config::Tiny;
use File::Spec::Functions qw(catfile);
use File::Which;
use Getopt::Long;
use IPC::System::Simple qw(systemx capturex);
use Mail::Box::Manager;

my $bts = "https://bugs.debian.org";
GetOptions "bts-server=s" => \$bts;

die "usage: notmuch-slurp-debbug [--bts-server=SERVER] BUG"
  unless @ARGV == 1;
die "notmuch-slurp-debbug: this script requires notmuch to be installed"
  unless which "notmuch";
die "notmuch-slurp-debbug: this script requires the 'devscripts' apt package"
  unless which "bts";
my $bug = pop @ARGV;

my $mgr = Mail::Box::Manager->new;
my $maildir;
my $conf_r = $ENV{XDG_CONFIG_HOME} || catfile $ENV{HOME}, ".config";
my $conf_f = catfile $conf_r, "mailscripts", "notmuch-slurp-debbug";
if (-f $conf_f) {
    my $Config = Config::Tiny::read($conf_f);
    $maildir = $Config->{_}->{maildir};
} else {
    # default to where a lot of people have their inbox
    chomp(my $database_path = `notmuch config get database.path`);
    $maildir = catfile $database_path, "inbox";
}
$maildir = $mgr->open(
    folder    => $maildir,
    access    => "a",
    keep_dups => 1,
    type      => "maildir"
);

# we use bts(1) to download the mbox because it has some logic to find
# the right URI and the user might have enabled its caching features.
# see #904182 for why we invoke it like this
systemx(
    qw(bts --bts-server),
    $bts, qw(--mbox --mailreader),
    "true %s", "show", $bug
);

my $cache_r = $ENV{XDG_CACHE_HOME} || catfile $ENV{HOME}, ".cache";
my $cache_d = catfile $cache_r, "devscripts", "bts";
my $mbox = $mgr->open(
    folder    => catfile($cache_d, "$bug.mbox"),
    access    => "r",
    keep_dups => 1,
    type      => "mbox"
);

foreach my $message ($mbox->messages) {
    my $mid = $message->messageId;
    # if this message does not have a message-id, do not import it;
    # that would be asking for trouble
    next unless defined $mid;
    $mid =~ s/(<|>)//g;

    chomp(my $match = capturex(qw(notmuch search), "id:$mid"));

    $mgr->copyMessage($maildir, $message) unless $match;
}

systemx(qw(notmuch new));