I have recently written a Perl script to synchronize my MH hierarchy with a
Maildir++. since MH and Maildir++ both keep messages in separate files, this
could be implemented entirely using hard links so it takes little hard drive
space and runs quickly (for a Perl script). A message can be added to or
removed from any folder in either hierarchy and the change will be propagated
to the other hierarchy. Maildir flags are mapped into a subset of MH
sequences.
I am an exmh user and every time I've tried to move away from it, I've become
frustrated with the poor job other MUAs do handling a mail hierarchy as complex as
mine. On the other hand, the ability to occasionally access my email
from a fully MIME-savvy mail reader on either my PC or my Mac can be very
useful.
This script allows me to go back and forth between MH and IMAP environments
with ease. I couldn't get an MH-based IMAP server to work, so I did this
instead. Besides, my other users are using a courier-imap and I didn't really
want to run another IMAP server on a funny port just for me.
I run this on my mail server every 2 minutes with cron.
I'd appreciate any comments or patches.
Chris
------------------------------------------------------------------------
#!/usr/bin/perl -w
#
# Version 0.1, released under the GPL.
=heaad1 NAME
mhaildirsync - Synchronizes am MH hierarchy with a Maildir++ bidirectionally
=head1 SYNOPSES
mhaildirsync [--verbose]
=head1 DESCRIPTION
Bidirectionally synchronizes an MH hierarchy with a Maildir++. The
synchronization is done entirely within the file system using hard
links, so both the MH hierarchy and the Maildir++ must exist in the
same file system. Maildir flags are mapped to MH sequences as follows:
=over
=item S
All messages are added to the 'unseen' sequence except those with the
S(een) flag.
=item P
The P(assed) flag is mapped to the "passed" sequence.
=item R
The R(eplied) flag is mapped to the "replied" sequence.
=item T
Messages with the T(rashed) flag are not sync'd.
=item D
The D(raft) flag is mapped to the "draft" sequence.
=item F
The F(lagged) flag is mapped to a user defined sequence, by default
'highlighted'.
=back
=head1 FILES
=over
=item ~/Mail
The MH hierarchy.
=item ~/Maildir
The Maildir++ hierarchy.
=item ~/.mhaildir
The cache hierarchy
The format of this is similar to an MH hierarchy except that it does
not use sequences files. Instead the sequences are coded into the
file name following the message number.
=item ~/.mhailsyncrc
An included Perl file in which other parameters may be overridden.
=over
=item $mhdir
The MH hierarchy.
=item $maildir
The Maildir++ hierarchy.
=item $cachedir
The cache hierarchy.
=item $mhsequencesfile
Name of the sequences file. By default, '.mhsequences'.
=item $flaggedseq
Sequence to which the F flag is mapped. By default, 'hilighted'.
=item $lockbin
Path to lockfile executable from procmail. By default
'/usr/bin/lockfile'. Not used if $lockfile is undefined.
=item $lockfile
Name of file used with lockfile. By default, ''. Set to '.lock' to
enable use of lockfile.
=item $bifffolder
Name of script to run to let exmh (or other mh based reader) to notify
MUA of changes. By default, ''. The bifffolder script from exmh
works here.
=item $hostname
Name of host used in creating file names in Maildir++. By default,
the value returned bin /bin/hostname.
=back
=back
=cut
use Time::HiRes;
use Getopt::Long;
$verbose = 0;
$mhsequencesfile = '.mhsequences';
$flaggedseq = 'hilighted';
$lockbin = '/usr/bin/lockfile';
$lockfile = '';
# $lockfile = '.lock';
$bifffolder = '';
$hostname = `/bin/hostname`;
chomp($hostname);
$mhailsyncrc = $ENV{HOME} . '/.mhailsyncrc';
$mhdir = $ENV{HOME} . '/Mail';
$maildir = $ENV{HOME} . '/Maildir';
$cachedir = $ENV{HOME} . '/.mhaildir';
if (-e $mhailsyncrc) {
require $mhailsyncrc;
}
GetOptions('verbose!' => \$verbose,
) or die;
my %cachefiles = ();
my %mhfiles = ();
my %maildirfiles = ();
sub cachemailpath {
my ($fn) = @_;
($fn =~ m!^$cachedir/(.*)/\d+(,[\w,]+)?$!)
|| die "Is $fn a valid cache path?";
return $1;
}
sub mhmailpath {
my ($fn) = @_;
($fn =~ m!^$mhdir/(.*)/\d+$!)
|| die "Is $fn a valid cache path?";
return $1;
}
sub maildirmailpath {
my ($fn) = @_;
if ($fn =~ m!^$maildir/(new|cur)/.*$!) {
return 'inbox';
}
($fn =~ m!^$maildir/.([^/]*)/(new|cur)/.*$!)
|| die "Is $fn a valid cache path?";
my $mailpath = $1;
$mailpath =~ s!\.!/!g;
$mailpath =~ s!DOT!\.!g;
return $mailpath;
}
sub initcachedata {
my ($dir) = @_;
opendir(DIR, $dir)
or die "Couldn't read $dir: $!";
my @files = readdir(DIR);
closedir(DIR);
foreach my $fn (grep {/^[^.]/} @files) {
my $path = "$dir/$fn";
if (-d $path) {
initcachedata($path);
} elsif ($fn =~ /^\d+(,([\w,]+))?$/) {
my $seqs = ($2||'');
my $inode = (stat($path))[1];
my $mailpath = cachemailpath($path);
if (exists $cachefiles{$inode}{$mailpath}) {
die "Cache message $inode in $mailpath exists twice:\n
$cachefiles{$inode}{$mailpath}{filename}\n $path";
}
$cachefiles{$inode}{$mailpath}{filename} = $path;
$cachefiles{$inode}{$mailpath}{seqs} = [split(/,/, $seqs)];
}
}
}
sub parseseq {
my ($seq) = @_;
map {
if (/(\d+)-(\d+)/) {
$1..$2;
} else {
$_;
}
} split(/\s+/, $seq)
}
sub makeseq {
my @msgs = sort {$a <=> $b} (@_);
if (@msgs) {
my @seq = ();
my $last = my $start = shift(@msgs);
while(my $next = shift(@msgs)) {
if ($next == $last + 1) {
$last = $next;
} else {
if ($start == $last) {
push @seq, $start;
} else {
push @seq, "$start-$last";
}
$last = $start = $next;
}
}
if ($start == $last) {
push @seq, $start;
} else {
push @seq, "$start-$last";
}
join(' ', @seq);
} else {
'';
}
}
sub initmhdata {
my ($dir) = @_;
opendir(DIR, $dir)
or die "Couldn't read $dir: $!";
my @files = readdir(DIR);
closedir(DIR);
my @seqs = ();
if (open(SEQ, "$dir/$mhsequencesfile")) {
while (<SEQ>) {
chomp;
my ($seqname, $seq) = split(/:\s*/);
unless ($seqname =~ /^Current-Folder$/i) {
foreach (parseseq($seq)) {
push @{$seqs[$_]}, $seqname;
}
}
}
close(SEQ);
}
foreach my $fn (grep {/^[^.]/} @files) {
my $path = "$dir/$fn";
if (-d $path) {
initmhdata($path);
} elsif ($fn =~ /^\d+$/) {
my $inode = (stat($path))[1];
my $mailpath = mhmailpath($path);
if (exists $mhfiles{$inode}{$mailpath}) {
die "mh message $inode in $mailpath exists twice:\n
$mhfiles{$inode}{$mailpath}{filename}\n $path";
}
$mhfiles{$inode}{$mailpath}{filename} = $path;
if ($seqs[$fn]) {
$mhfiles{$inode}{$mailpath}{seqs} = [sort @{$seqs[$fn]}];
} else {
$mhfiles{$inode}{$mailpath}{seqs} = [];
}
}
}
}
sub getsubmaildirfiles {
my ($dir) = @_;
foreach (qw(new cur)) {
opendir(DIR, "$dir/$_")
or die "Couldn't read $dir/$_: $!";
my @files = readdir(DIR);
closedir(DIR);
foreach my $fn (grep {/^[^.]/} @files) {
my @seqs = ();
my $unseen = 1;
if ($fn =~ m!:2,(\w*)$!) {
my $flags = $1;
if ($flags =~ /S/) {
$unseen = 0;
}
if ($flags =~ /P/) {
push @seqs, 'passed';
}
if ($flags =~ /R/) {
push @seqs, 'replied';
}
if ($flags =~ /T/) {
push @seqs, 'trashed';
}
if ($flags =~ /D/) {
push @seqs, 'draft';
}
if ($flags =~ /F/) {
push @seqs, $flaggedseq;
}
}
if ($unseen) {
push @seqs, 'unseen';
}
unless (grep {/trashed/} @seqs) {
my $path = "$dir/$_/$fn";
my $inode = (stat($path))[1];
my $mailpath = maildirmailpath($path);
if (exists $maildirfiles{$inode}{$mailpath}) {
die "Maildir message $inode in $mailpath exists twice:\n
$maildirfiles{$inode}{$mailpath}{filename}\n $path";
}
$maildirfiles{$inode}{$mailpath}{filename} = $path;
if (@seqs) {
$maildirfiles{$inode}{$mailpath}{seqs} = [@seqs];
} else {
$maildirfiles{$inode}{$mailpath}{seqs} = [];
}
}
}
}
}
sub initmaildirdata {
my ($dir) = @_;
opendir(DIR, $dir)
or die "Couldn't read $dir: $!";
my @files = readdir(DIR);
closedir(DIR);
getsubmaildirfiles($dir);
foreach my $fn (grep {/^\.[^.]/} @files) {
getsubmaildirfiles("$dir/$fn");
}
}
sub makeparentdir {
my ($path) = @_;
unless ($path =~ s!/[^/]*$!!) {
die "Is $path a valid path?";
}
unless (-d $path) {
if (-e $path) {
die "$path exists and is not a directory";
}
makeparentdir($path);
mkdir($path)
or die "Can't create $path: $!";
#$verbose && warn "Created directory $path\n";
}
}
sub makeparentmaildir {
my ($path) = @_;
unless ($path =~ s!/(cur|new|tmp)/[^/]*$!!) {
die "Is $path a valid maildir path?";
}
makeparentdir("$path/new");
(-d "$path/new")
or mkdir("$path/new")
or die "Can't create $path/new: $!";
(-d "$path/cur")
or mkdir("$path/cur")
or die "Can't create $path/cur: $!";
(-d "$path/tmp")
or mkdir("$path/tmp")
or die "Can't create $path/tmp: $!";
#$verbose && warn "Created maildir $path\n";
}
sub max {
my $max = pop(@_);
while (my $n = pop(@_)) {
if ($n > $max) {
$max = $n;
}
}
return($max);
}
sub mailpathtocachepath {
my ($mailpath) = @_;
my $dirpath = "$cachedir/$mailpath";
if (opendir(DIR, $dirpath)) {
my @messages = map {
s/,.*$//;
$_;
} grep {
/^\d+/;
} readdir(DIR);
closedir(DIR);
my $messno = (max(@messages)||0) + 1;
return("$dirpath/$messno");
} else {
return "$dirpath/1";
}
}
sub mailpathtomhpath {
my ($mailpath) = @_;
my $dirpath = "$mhdir/$mailpath";
if (opendir(DIR, $dirpath)) {
my @messages = grep {
/^\d+$/;
} readdir(DIR);
closedir(DIR);
my $messno = (max(@messages)||0) + 1;
return("$dirpath/$messno");
} else {
return "$dirpath/1";
}
}
sub addseqstocache {
my ($inode, $mailpath, @addseqs) = @_;
my @oldseqs = @{$cachefiles{$inode}{$mailpath}{seqs}};
my %seqs = ();
foreach (@oldseqs, @addseqs) {
$seqs{$_} = $_;
}
my @seqs = sort(keys %seqs);
$cachefiles{$inode}{$mailpath}{seqs} = [@seqs];
my $shortfn = my $oldfn = $cachefiles{$inode}{$mailpath}{filename};
$shortfn =~ s/,[\w,]+$//;
my $newfn;
if (@seqs) {
$newfn = $shortfn . ',' . join(',', @seqs);
} else {
$newfn = $shortfn;
}
unless ($oldfn eq $newfn) {
link($oldfn, $newfn)
or die "Couldn't link $oldfn to $newfn: $!";
unlink($oldfn)
or die "Could't unlink $oldfn: $!";
$cachefiles{$inode}{$mailpath}{filename} = $newfn;
}
}
sub delseqsfromcache {
my ($inode, $mailpath, @delseqs) = @_;
my @oldseqs = @{$cachefiles{$inode}{$mailpath}{seqs}};
my @seqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @delseqs;
} @oldseqs;
$cachefiles{$inode}{$mailpath}{seqs} = [@seqs];
my $shortfn = my $oldfn = $cachefiles{$inode}{$mailpath}{filename};
$shortfn =~ s/,[\w,]+$//;
my $newfn;
if (@seqs) {
$newfn = $shortfn . ',' . join(',', @seqs);
} else {
$newfn = $shortfn;
}
unless ($oldfn eq $newfn) {
link($oldfn, $newfn)
or die "Couldn't link $oldfn to $newfn: $!";
unlink($oldfn)
or die "Could't unlink $oldfn: $!";
$cachefiles{$inode}{$mailpath}{filename} = $newfn;
}
}
sub addmessagetocache {
my ($inode, $mailpath, $fn, @seqs) = @_;
if (exists($cachefiles{$inode}{$mailpath})) {
addseqstocache($inode, $mailpath, @seqs);
} else {
my $cachepath = mailpathtocachepath($mailpath);
makeparentdir($cachepath);
if (link($fn, $cachepath)) {
$cachefiles{$inode}{$mailpath}{filename} = $cachepath;
$cachefiles{$inode}{$mailpath}{seqs} = [];
addseqstocache($inode, $mailpath, @seqs);
} else {
warn "Couldn't link $fn to $cachepath: $!";
}
}
}
sub addseqstomh {
my ($inode, $mailpath, @addseqs) = @_;
if (@addseqs) {
my @oldseqs = @{$mhfiles{$inode}{$mailpath}{seqs}};
my %seqs = ();
foreach (@oldseqs, @addseqs) {
$seqs{$_} = $_;
}
my @seqs = sort(keys %seqs);
if (join(' ', @seqs) ne join(' ', @oldseqs)) {
my $path = $mhfiles{$inode}{$mailpath}{filename};
my ($dir, $fn) = ($path =~ m!^(.*)/(.*)$!);
my %folderseqs = ();
if ($lockfile) {
if (system($lockbin, "$dir/$lockfile") == 0) {
if ($? == -1) {
die "failed to lock $dir/$lockfile: $!";
} elsif ($? & 127) {
die sprintf("$lockbin died with signal %d, %s coredump",
($? & 127), ($? & 128) ? 'with' :
'without');
} else {
my $ret = ($? >> 8);
if ($ret) {
die sprintf("$lockbin exited with value %d", $ret);
}
}
}
}
if (open(SEQ, "$dir/$mhsequencesfile")) {
my @seq = <SEQ>;
close(SEQ);
foreach (@seq) {
chomp;
my ($seqname, $seq) = split(/:\s*/);
$folderseqs{$seqname} = $seq;
}
}
my $change = 0;
foreach (@addseqs) {
if (exists $folderseqs{$_}) {
my %msgs = ();
$msgs{$fn} = $fn;
foreach (parseseq($folderseqs{$_})) {
$msgs{$_} = $_;
}
my $newseq = makeseq(keys %msgs);
if ($newseq) {
if ($folderseqs{$_} ne $newseq) {
$folderseqs{$_} = $newseq;
$change = 1;
}
} else {
delete($folderseqs{$_});
$change = 1;
}
} else {
$folderseqs{$_} = $fn;
$change = 1;
}
}
if ($change) {
if (open(SEQ, ">$dir/$mhsequencesfile")) {
foreach (sort keys %folderseqs) {
print SEQ "$_: $folderseqs{$_}\n";
}
close(SEQ);
}
}
if ($lockfile) {
unlink "$dir/$lockfile";
}
if ($bifffolder) {
if (system($bifffolder, $mailpath) == 0) {
if ($? == -1) {
warn "failed to $bifffolder $mailpath: $!";
} elsif ($? & 127) {
warn sprintf("$bifffolder died with signal %d, %s
coredump",
($? & 127), ($? & 128) ? 'with' :
'without');
} else {
my $ret = ($? >> 8);
if ($ret) {
warn sprintf("$bifffolder exited with value %d",
$ret);
}
}
}
}
$mhfiles{$inode}{$mailpath}{seqs} = [@seqs];
}
}
}
sub delseqsfrommh {
my ($inode, $mailpath, @delseqs) = @_;
if (@delseqs) {
my @oldseqs = @{$mhfiles{$inode}{$mailpath}{seqs}};
my @seqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @delseqs;
} @oldseqs;
if (join(' ', @seqs) ne join(' ', @oldseqs)) {
my $path = $mhfiles{$inode}{$mailpath}{filename};
my ($dir, $fn) = ($path =~ m!^(.*)/(.*)$!);
my %folderseqs = ();
if ($lockfile) {
if (system($lockbin, "$dir/$lockfile") == 0) {
if ($? == -1) {
die "failed to lock $dir/$lockfile: $!";
} elsif ($? & 127) {
die sprintf("$lockbin died with signal %d, %s coredump",
($? & 127), ($? & 128) ? 'with' :
'without');
} else {
my $ret = ($? >> 8);
if ($ret) {
die sprintf("$lockbin exited with value %d", $ret);
}
}
}
}
if (open(SEQ, "$dir/$mhsequencesfile")) {
my @seq = <SEQ>;
close(SEQ);
foreach (@seq) {
chomp;
my ($seqname, $seq) = split(/:\s*/);
$folderseqs{$seqname} = $seq;
}
}
my $change = 0;
foreach (@delseqs) {
if (exists $folderseqs{$_}) {
my %msgs = ();
foreach (parseseq($folderseqs{$_})) {
$msgs{$_} = $_;
}
delete($msgs{$fn});
my $newseq = makeseq(keys %msgs);
if ($folderseqs{$_} ne $newseq) {
$folderseqs{$_} = $newseq;
$change = 1;
}
}
}
if ($change) {
if (open(SEQ, ">$dir/$mhsequencesfile")) {
foreach (sort keys %folderseqs) {
print SEQ "$_: $folderseqs{$_}\n";
}
close(SEQ);
}
}
if ($lockfile) {
unlink "$dir/$lockfile";
}
if ($bifffolder) {
if (system($bifffolder, $mailpath) == 0) {
if ($? == -1) {
warn "failed to $bifffolder $mailpath: $!";
} elsif ($? & 127) {
warn sprintf("$bifffolder died with signal %d, %s
coredump",
($? & 127), ($? & 128) ? 'with' :
'without');
} else {
my $ret = ($? >> 8);
if ($ret) {
warn sprintf("$bifffolder exited with value %d",
$ret);
}
}
}
}
$mhfiles{$inode}{$mailpath}{seqs} = [@seqs];
}
}
}
sub addmessagetomh {
my ($inode, $mailpath, $fn, @seqs) = @_;
if (exists($mhfiles{$inode}{$mailpath})) {
addseqstomh($inode, $mailpath, @seqs);
} else {
my $mhpath = mailpathtomhpath($mailpath);
makeparentdir($mhpath);
if (link($fn, $mhpath)) {
$mhfiles{$inode}{$mailpath}{filename} = $mhpath;
$mhfiles{$inode}{$mailpath}{seqs} = [];
addseqstomh($inode, $mailpath, @seqs);
} else {
warn "Couldn't link $fn to $mhpath: $!";
}
}
}
sub addseqstomaildir {
my ($inode, $mailpath, @addseqs) = @_;
my @oldseqs = @{$maildirfiles{$inode}{$mailpath}{seqs}};
my %seqs = ();
foreach (sort grep {
my $seq = $_;
grep {
$_ eq $seq;
} qw(unseen passed replied trashed draft), $flaggedseq;
} @oldseqs, @addseqs) {
$seqs{$_} = $_;
}
my @seqs = sort(keys %seqs);
$maildirfiles{$inode}{$mailpath}{seqs} = [@seqs];
my $oldfn = $maildirfiles{$inode}{$mailpath}{filename};
(my $newfn = $oldfn) =~ s!:[^:/]*$!!;
my @flags = ();
unless ($seqs{unseen}) {
push @flags, 'S';
}
if ($seqs{passed}) {
push @flags, 'P';
}
if ($seqs{replied}) {
push @flags, 'R';
}
if ($seqs{trashed}) {
push @flags, 'T';
}
if ($seqs{draft}) {
push @flags, 'D';
}
if ($seqs{$flaggedseq}) {
push @flags, 'F';
}
my $flags = join('', sort @flags);
if ($flags) {
$newfn .= ":2,$flags";
$newfn =~ s!(.*)/new/!$1/cur/!;
}
unless ($oldfn eq $newfn) {
link($oldfn, $newfn)
or die "Couldn't link $oldfn to $newfn: $!";
unlink($oldfn)
or die "Could't unlink $oldfn: $!";
$maildirfiles{$inode}{$mailpath}{filename} = $newfn;
}
}
sub delseqsfrommaildir {
my ($inode, $mailpath, @delseqs) = @_;
my @oldseqs = @{$maildirfiles{$inode}{$mailpath}{seqs}};
my @seqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @delseqs;
} @oldseqs;
$maildirfiles{$inode}{$mailpath}{seqs} = [@seqs];
my $oldfn = $maildirfiles{$inode}{$mailpath}{filename};
(my $newfn = $oldfn) =~ s!:[^:/]*$!!;
my @flags = ();
my $seen = 1;
foreach (@seqs) {
if (/^unseen$/) {
$seen = 0;
} elsif (/^passed$/) {
push @flags, 'P';
} elsif (/^replied$/) {
push @flags, 'R';
} elsif (/^trashed$/) {
push @flags, 'T';
} elsif (/^draft$/) {
push @flags, 'D';
} elsif (/^${flaggedseq}$/) {
push @flags, 'F';
}
}
if ($seen) {
push @flags, 'S';
}
my $flags = join('', sort @flags);
if ($flags) {
$newfn .= ":2,$flags";
$newfn =~ s!(.*)/new/!$1/cur/!;
}
unless ($oldfn eq $newfn) {
link($oldfn, $newfn)
or die "Couldn't link $oldfn to $newfn: $!";
unlink($oldfn)
or die "Could't unlink $oldfn: $!";
$maildirfiles{$inode}{$mailpath}{filename} = $newfn;
}
}
sub addmessagetomaildir {
my ($inode, $mailpath, $fn, @seqs) = @_;
if (exists($maildirfiles{$inode}{$mailpath})) {
addseqstomaildir($inode, $mailpath, @seqs);
} else {
my $maildirpath = mailpathtomaildirpath($mailpath);
makeparentmaildir("$maildirpath");
if (link($fn, "$maildirpath")) {
$maildirfiles{$inode}{$mailpath}{filename} = $maildirpath;
$maildirfiles{$inode}{$mailpath}{seqs} = [];
addseqstomaildir($inode, $mailpath, @seqs);
} else {
warn "Couldn't link $fn to $maildirpath: $!";
}
}
}
sub findnewmhmessages {
foreach (keys %mhfiles) {
foreach my $mailpath (keys %{$mhfiles{$_}}) {
my @seqs = @{$mhfiles{$_}{$mailpath}{seqs}};
if (exists($cachefiles{$_}{$mailpath})) {
my @cacheseqs = ();
if (exists $cachefiles{$_}{$mailpath}{seqs}) {
@cacheseqs = @{$cachefiles{$_}{$mailpath}{seqs}};
}
my @addseqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @cacheseqs;
} @seqs;
if (@addseqs) {
$verbose && warn "Adding " . join(' ', @addseqs) . " to mh
message $_ in $mailpath\n";
addseqstomaildir($_, $mailpath, @addseqs);
addseqstocache($_, $mailpath, @addseqs);
}
my @delseqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @seqs;
} @cacheseqs;
if (@delseqs) {
$verbose && warn "Removing " . join(' ', @delseqs) . " from mh
message $_ in $mailpath\n";
delseqsfrommaildir($_, $mailpath, @delseqs);
delseqsfromcache($_, $mailpath, @delseqs);
}
} else {
my $fn = $mhfiles{$_}{$mailpath}{filename};
$verbose && warn "Found mh message $_ in $mailpath\n";
addmessagetomaildir($_, $mailpath, $fn, @seqs);
addmessagetocache($_, $mailpath, $fn, @seqs);
}
}
}
}
sub findnewmaildirmessages {
foreach (keys %maildirfiles) {
foreach my $mailpath (keys %{$maildirfiles{$_}}) {
my @seqs = @{$maildirfiles{$_}{$mailpath}{seqs}};
if (exists($cachefiles{$_}{$mailpath})) {
my @cacheseqs = ();
if (exists $cachefiles{$_}{$mailpath}{seqs}) {
@cacheseqs = grep {
my $seq = $_;
grep {
$_ eq $seq;
} qw(unseen passed replied trashed draft), $flaggedseq;
} @{$cachefiles{$_}{$mailpath}{seqs}};
}
my @addseqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @cacheseqs;
} @seqs;
if (@addseqs) {
$verbose && warn "Adding " . join(' ', @addseqs) . " to maildir
message $_ in $mailpath\n";
addseqstomh($_, $mailpath, @addseqs);
addseqstocache($_, $mailpath, @addseqs);
}
my @delseqs = grep {
my $seq = $_;
!grep {
$_ eq $seq;
} @seqs;
} @cacheseqs;
if (@delseqs) {
$verbose && warn "Removing " . join(' ', @delseqs) . " from
maildir message $_ in $mailpath\n";
delseqsfrommh($_, $mailpath, @delseqs);
delseqsfromcache($_, $mailpath, @delseqs);
}
} else {
my $fn = $maildirfiles{$_}{$mailpath}{filename};
$verbose && warn "Found maildir message $_ in $mailpath\n";
addmessagetomh($_, $mailpath, $fn, @seqs);
addmessagetocache($_, $mailpath, $fn, @seqs);
}
}
}
}
sub delmessagefromcache {
my ($inode, $mailpath) = @_;
my $fn = $cachefiles{$inode}{$mailpath}{filename};
if ($fn) {
unlink($fn)
or warn "Couldn't unlink $fn: $!";
delete($cachefiles{$inode}{$mailpath});
unless (keys %{$cachefiles{$inode}}) {
delete($cachefiles{$inode});
}
}
}
sub delmessagefrommh {
my ($inode, $mailpath) = @_;
my $path = $mhfiles{$inode}{$mailpath}{filename};
if ($path) {
unlink($path)
or warn "Couldn't unlink $path: $!";
delseqsfrommh($inode, $mailpath, @{$mhfiles{$inode}{$mailpath}{seqs}});
delete($mhfiles{$inode}{$mailpath});
unless (keys %{$mhfiles{$inode}}) {
delete($mhfiles{$inode});
}
}
}
sub delmessagefrommaildir {
my ($inode, $mailpath) = @_;
my $fn = $maildirfiles{$inode}{$mailpath}{filename};
unlink($fn)
or die "Couldn't unlink $fn: $!";
delete($maildirfiles{$inode}{$mailpath});
unless (keys %{$maildirfiles{$inode}}) {
delete($maildirfiles{$inode});
}
}
sub deloldmhmessages {
foreach (keys %cachefiles) {
if (exists($mhfiles{$_})) {
foreach my $mailpath (keys %{$cachefiles{$_}}) {
unless (exists($mhfiles{$_}{$mailpath}{filename})) {
delmessagefromcache($_, $mailpath);
delmessagefrommaildir($_, $mailpath);
$verbose && warn "mh message $_ moved from $mailpath\n"
}
}
} else {
foreach my $mailpath (keys %{$cachefiles{$_}}) {
delmessagefromcache($_, $mailpath);
delmessagefrommaildir($_, $mailpath);
$verbose && warn "mh message $_ removed from $mailpath\n";
}
}
}
}
sub deloldmaildirmessages {
foreach (keys %cachefiles) {
if (exists($maildirfiles{$_})) {
foreach my $mailpath (keys %{$cachefiles{$_}}) {
unless (exists($maildirfiles{$_}{$mailpath}{filename})) {
delmessagefromcache($_, $mailpath);
delmessagefrommh($_, $mailpath);
$verbose && warn "maildir message $_ moved from $mailpath\n"
}
}
} else {
foreach my $mailpath (keys %{$cachefiles{$_}}) {
delmessagefromcache($_, $mailpath);
delmessagefrommh($_, $mailpath);
$verbose && warn "maildir message $_ removed from $mailpath\n";
}
}
}
}
sub mailpathtomaildirpath {
my ($mailpath) = @_;
$mailpath =~ s!\.!DOT!g;
$mailpath =~ s!/!\.!g;
my $maildirpath = (($mailpath ne 'inbox') ?
"$maildir/.$mailpath" :
"$maildir");
my $time = Time::HiRes::time();
my $filename = "$time.$$.$hostname";
return("$maildirpath/new/$filename");
}
initcachedata($cachedir);
initmhdata($mhdir);
initmaildirdata($maildir);
findnewmhmessages();
findnewmaildirmessages();
deloldmaildirmessages();
deloldmhmessages();
------------------------------------------------------------------------
Chris Garrigues Trinsic Solutions
President 710-B West 14th Street
Austin, TX 78701-1755
512-322-0180 http://www.trinsics.com
Would you rather proactively pay for
uptime or reactively pay for downtime?
Trinsic Solutions
Your Proactive IT Management Partner
------------------------------------------------------------------------
_______________________________________________
Nmh-workers mailing list
Nmh-workers@nongnu.org
http://lists.nongnu.org/mailman/listinfo/nmh-workers