#!/usr/bin/perl -w

use Encode qw/encode decode/;
use Getopt::Long;
use File::Find;
use File::Copy qw/copy/;
use File::Path qw/mkpath/;
use strict;

my ($sourceDir,$destinationDir,$archiveDir)=("","","");
GetOptions ("s=s",=>\$sourceDir,"d=s"=>\$destinationDir,"a=s"=>\$archiveDir);

if (!$sourceDir || !$destinationDir || !$archiveDir) {
 print "USAGE: $0 -s <chemin source> -a <repertoire archive> -d <chemin destination>\n";
 exit 1;
}

find({ wanted => \&wantedFile, follow => 1,no_chdir =>1 }, $sourceDir);

sub wantedFile {
 if ($_=~/$archiveDir$/) {
  foreach my $currentFile (glob("$_/#msgs/*.eml")) {
   my $subject="";
   open(F,"$currentFile");
   while(my $currentLine=<F>) {
    chop $currentLine;
    if (($currentLine=~/Subject: (.*)/) && ($1!~/^ +$/) && ($1!~/<[^>]*>/)) {
     $subject=$1;
    }
    last if ($subject ne "");
   }
   close(F);
   if ($subject eq "") {
    $subject="Mail archivé sans nom";
   } else {
     my ($encoding,$subjectWithoutEncoding)=($subject=~/=\?(.*?)\?.\?(.*)\?=/);
     if ($encoding) {
      $subjectWithoutEncoding=~s/=([a-fA-F0-9]{2})/chr(hex "$1")/eg;
      my $decodeSubjectWithoutEncoding=decode($encoding,$subjectWithoutEncoding);
      $subject=encode("utf-8",$decodeSubjectWithoutEncoding);
     }
   }
   $subject=~s/[\/:*?"<>|]/_/g; $subject=~s/ /-/g;

   my ($currentUser,$currentFilename)=($currentFile=~/$sourceDir\/?(.*?)\/.*\/(.*)/);
   mkpath("$destinationDir/$currentUser/$archiveDir");
   copy("$currentFile","$destinationDir/$currentUser/$archiveDir/$subject-$currentFilename");
  }
 }
}