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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#!/usr/bin/perl
# Copyright (C) 2019 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 <http://www.gnu.org/licenses/>.
use 5.028;
use strict;
use warnings;
use constant THIRTYONE => 31 * 24 * 60 * 60;
use File::Spec::Functions qw(catfile splitpath);
use POSIX qw(strftime);
use IO::Compress::Gzip qw(gzip $GzipError);
use Mail::Box::Manager;
# CONFIG
our $maildirs = "$ENV{HOME}/.fmail";
our $mboxes = "$ENV{HOME}/annex/mail";
our $fmail_annex = "$ENV{HOME}/.fmail/annex";
our %names = (inbox => 'archive', sent => 'sent');
our @annex_sync_remotes = qw(origin cloud);
# CODE
# might use Proc::Find from CPAN instead of this
system "pgrep -u $ENV{USER} mbsync";
die "mbsync is running" if $? == 0;
die "no dest!" unless -d $mboxes;
die "no source!" unless -d $maildirs;
system "movemymail";
system "touch $ENV{HOME}/.nomovemymail";
-e or mkdir
for $fmail_annex, map catfile($fmail_annex, $_), "cur", "new", "tmp";
open my $touch_fh, ">", catfile $fmail_annex, ".duplicity-ignore";
my $suffix = lc strftime("-%b-%Y", localtime);
my @gzipped_mboxes;
foreach my $name (keys %names) {
my $source = catfile $maildirs, $name;
my $target_name = $names{$name} . $suffix;
my $target = catfile $mboxes, $target_name;
my $target_gz = "$target.gz";
# Bail out if compressed mbox exists: that means this month's archive has
# already happened. It's okay to append to a not-yet-compressed mbox, as
# that probably means that the archival process was interrupted.
die "wanted to archive $source to $target but $target_gz already exists\n"
if -e $target_gz;
# Each loop iteration has its own Mail::Box::Manager because we want to
# call closeAllfolders and thereby perform all the moves and copies.
my $mgr = Mail::Box::Manager->new;
my $source_handle = $mgr->open(
$source,
access => "rw",
create => 0,
keep_dups => 1,
type => "maildir"
);
my $target_handle = $mgr->open(
$target,
access => "a",
create => 1,
keep_dups => 1,
type => "mbox"
);
my $fmail_annex_handle
= $mgr->open($fmail_annex, access => "a", type => "maildir");
my $now = time;
for (@$source_handle) {
$now - $_->timestamp > THIRTYONE or next;
$_->label("seen") or next;
$_->label("flagged") and next;
$mgr->copyMessage($fmail_annex_handle, $_);
$mgr->moveMessage($target_handle, $_);
}
$fmail_annex_handle->acceptMessages;
$mgr->closeAllFolders;
open my $touch_fh, ">",
catfile $fmail_annex, ".expanded", $target_name;
gzip $target, $target_gz or die "gzip failed: $GzipError\n";
-e $target_gz and unlink $target;
push @gzipped_mboxes, $target_gz;
}
chdir $mboxes;
system "git annex add @gzipped_mboxes";
system "git annex sync @annex_sync_remotes -C .";
unlink "$ENV{HOME}/.nomovemymail";
system "notmuch new";
|
