summaryrefslogtreecommitdiff
path: root/maildir-import-patch
blob: 605435b959d9b22fe3ae0e03ecba9373933d1244 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
#!/usr/bin/perl

# maildir-import-patch -- import a git patch series into a maildir

# Copyright (C) 2019-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 Cwd;
use File::Basename;
use File::Temp ();
use File::Which;
use List::MoreUtils "firstidx";
use Mail::Box::Manager;

my $us          = basename $0;
my $maildir_dir = shift
  or die "$us: usage: $us MAILDIR [git-format-patch(1) args]\n";
which "git" or die "$us: this script requires git to be installed\n";
eval { require Git::Wrapper }
  or die "$us: this script requires Git::Wrapper (libgit-wrapper-perl)\n";

my $git = Git::Wrapper->new(getcwd);
my $toplevel;
{
    local $@;
    eval { ($toplevel) = $git->rev_parse({ show_toplevel => 1 }) };
    $@ and die "$us: pwd doesn't look like a git repository ..\n";
}
$toplevel =~ s/\.git$//;

if (firstidx(sub { /^--subject-prefix/ }, @ARGV) == -1) {
    my $subject_prefix;
    my $rfc_idx = firstidx { /^--rfc$/ } @ARGV;
    if ($rfc_idx == -1) {
        $subject_prefix = "PATCH";
    } else {
        $subject_prefix = "RFC PATCH";
        splice @ARGV, $rfc_idx, 1;
    }
    my ($project) = $git->config(qw|--local --get --default|,
        basename($toplevel), "mailscripts.project-shortname");
    unshift @ARGV, "--subject-prefix=$subject_prefix $project imported";
}

my $mgr = Mail::Box::Manager->new;
my $maildir
  = $mgr->open($maildir_dir, type => "maildir", access => "w", create => 1);

my $mbox_file = File::Temp->new;
my $pid       = fork;
die "fork() failed: $!" unless defined $pid;
unless ($pid) {
    open STDOUT, ">&=", $mbox_file->fileno
      or die "couldn't reopen child's STDOUT: $!";
    exec qw(git format-patch --no-cc --no-to --stdout --thread=shallow), @ARGV;
}
$mbox_file->close;
wait;

my $mbox = $mgr->open($mbox_file->filename, type => "mbox", access => "r");
$mgr->copyMessage($maildir, $_) for $mbox->messages;