[Thunderbird, MBOX, Perl] Compactage des fichiers MBOX

• Il existe une extension pour Thunderbird permettant de compacter tous les dossiers d’un coup : Xpunge

Script Perl permettant de compacter les fichiers de stockage des mails de Thunderbird (fichiers au format MBOX) en supprimant les messages marqués comme “effacés” (entête “X-Mozilla-Status” a le bit 4 à 1 - voir X-Mozilla-Status explained)

use warnings;
use File::Find;
 
if ($#ARGV != -1)
{
	$chemin = $ARGV[0]."/";
} else {
	$chemin = "./";
}
 
find(\&SearchFunc, $chemin);
 
sub SearchFunc {
	my $file = $File::Find::name;
	if($file =~ m/\.msf$/gi) {
		$file =~ s/\.msf$//gi;
		if(-e $file) {
			CopyMBOX($file);
			CompressMBOX($file);
		}
	}
	return;
	
}
 
sub CompressMBOX {
	
	my $buffer;
	my $valeur;
	my $foundMessage=0,$foundstatus=0;
	my $nbmessages=0,$nbdeleted=0,$nbsaved=0;
	
	print "Compactage de $_[0] :\n";
	
	open(MBOXFILE, $_[0]) or die "Impossible d'ouvrir $_[0]\n";
	open(NEWFILE, ">$_[0]".".new") or die "Impossible de créer $_[0].new\n";
	
	foreach $line (<MBOXFILE>) {
		if($line =~ m/^From - /) {
			if($foundMessage == 2) {
				# On est déjà dans un message à sauvegarder mais on a trouvé un autre ?
				# C'est qu'il est fini, on l'écrit :
				print NEWFILE $buffer;
			} 
			$buffer="";
			$foundMessage=1;
			$foundstatus=0;
			$nbmessages++;
		}
		if($foundstatus == 0) {
			# On n'a pas déjà lu "X-Mozilla-Status: ", on continue
			# Sinon, le message est corrompu...
			if(($line =~ m/^X-Mozilla-Status: /) && $foundMessage == 1) {
				# On a trouvé un message et la ligne qui nous interresse
				# Il faut regarder si le 4ème bit est à 1
				$valeur= $';
				chomp($valeur);
				$valeur=hex($valeur);
				$foundstatus=1;
				if(!($valeur & 8)) {
					$nbsaved++;
					$foundMessage = 2;
				}
				else { $nbdeleted++; }
			}
		}
		$buffer.=$line;
	}
 
	if($foundMessage == 2) {
		# On est arrivé au dernier message et il faut le sauvegarder ?
		# On l'écrit :
		print NEWFILE $buffer;
	}
	
	print "Trouvé $nbmessages messages :\n- Sauvés : $nbsaved\n- Effacés : $nbdeleted\n\n";
	
	close MBOXFILE;
	close NEWFILE;
	
	copy($_[0].".new", $_[0]) or die "Impossible de faire la copie\n";
	unlink($_[0].".new") or die "Impossible de supprimer le fichier temporaire\n";
	
}
 
sub CopyMBOX {
	use File::Copy;
 
	print "Copie de sauvegarde de $_[0] vers $_[0].bak\n";
	my $file_orig=$_[0];
	my $file_bak=$_[0].".bak";
	copy($file_orig, $file_bak) or die "Impossible de faire la copie de sauvegarde";
}

• Plus d’informations sur le compactage des fichiers de données de Thunderbird sur la base de connaissances MozillaZine