Subject: | Mail::Box::Maildir::Message information lossage |
The current maildir message module doesn't respect all the possible
flags in use by various applications. Certain applications (dovecot
being a prime example) stores extra flags at the end in lower-case for
application specific purposes. If you use Mail::Box utilities to open
maildir folders created by applications like dovecot then upon close it
renames the files and all the extra markings get lost (which in my case,
is really really bad though fortunately they were mostly expiration
marks that I can at least recreate moderately easily).
The fix attached is actually to simply save and remember all lowercase
flags and then apply them later during save time. (I actually find it
odd that when I pass access => 'r' to the top level Mail::Box manager it
renames the files in the first place, but that's a different issue).
Ideally, I actually think it would be safer to remember all unknown tags
not just the lower case ones. But I wasn't sure how accepted that would
be (and will cause performance loss because of the need to resort flags
later). So the attached patch just deals with unknown lowercase flags.
Subject: | fix.patch |
--- Message.pm 2008-12-11 03:05:40.000000000 -0800
+++ /users/hardaker/f/x/tmp/h/Mail-Box-2.081/lib/Mail/Box/Maildir/Message.pm 2009-01-06 09:02:35.000000000 -0800
@@ -24,10 +23,15 @@
return $newname if defined $oldname && $oldname eq $newname;
my ($id, $semantics, $flags)
- = $newname =~ m!(.*?)(?:\:([12])\,([A-Z]*))!
+ = $newname =~ m!(.*?)(?:\:([12])\,([A-Za-z]*))!
? ($1, $2, $3)
: ($newname, '','');
+ # IMAP and other clients use lowercase flags to store application tags
+ ($self->{'lcflags'}) = ($flags =~ m/([a-z]+)/);
+ $self->{'lcflags'} ||= ''; # avoid undef warnings later
+ $flags =~ s/[a-z]+//;
+
my %flags;
$flags{$_}++ foreach split //, $flags;
@@ -89,7 +93,8 @@
. ($labels->{passed} ? 'P' : '')
. ($labels->{replied} ? 'R' : '')
. ($labels->{seen} ? 'S' : '')
- . ($labels->{deleted} ? 'T' : '');
+ . ($labels->{deleted} ? 'T' : '')
+ . $self->{'lcflags'};
my $newset = $labels->{accepted} ? 'cur' : 'new';
if($set ne $newset)