#!/usr/bin/perl -w
#
# ConvertToMB4.pl
#
# The mailbox conversion script for CommuniGate Pro.
#
# Using this script you can convert accounts' mailboxes from
# TextMailbox, MailDirMailbox and Sliced format to 4th Format.
# The script works on filesyatem level and needs to be launched
# on the server machine.
#
# Revision: 21-Oct-2021
#
# Mail your comments to support@communigatepro.ru
#

#use strict;

use lib ".";
use CLI;  #get one from communigatepro.ru/CGPerl/


####  YOU SHOLD REDEFINE THESE VARIABLES !!!

my $Login='postmaster';
my $Password='pass';

my $disableUser=0; # disable logins and receiving mail during conversion
                   # set this to 0 if the domain is suspended



my ($BaseDir);
if($^O eq 'MSWin32') {
  $BaseDir      = "C:/CommuniGatePro/";
} else {
  $BaseDir      = "/var/CommuniGate/";
}

my $tempSuffix="--temp--";
my $sliceFileSize=100*1024*1024;


# also un-commend one of the lines below to choose between all domains/one domain/one account

#### end of the customizeable variables list




my $cli = new CGP::CLI( { PeerAddr => '127.0.0.1',
                          PeerPort => 106,
                          login    => $Login,
                          password => $Password } )
   || die "*** Can't login to CGPro CLI: ".$CGP::ERR_STRING."\n";


# un-comment one of the below lines


processAccount('user@company.com');
#processDomain('company.com');
#processAllDomains();
#processFile('accountList.txt');



print "Done\n";
$cli->Logout();
exit;

sub processFile {
  my ($fname)=@_;
  open(FILE,$fname) || die "can't open $fname: $!\n";
  while(<FILE>) {
    chomp;
    next if(/^#/);
    my $account=$_;
    if(length($account)>3) {
      processAccount($account);
    }
  }
  close(FILE);
}

sub processAllDomains {
  my $DomainList = $cli->ListDomains()
               || die "*** Can't get the domain list: ".$cli->getErrMessage.", quitting";
  foreach(@$DomainList) {
    processDomain($_);
  }
}         

sub processDomain {
  my $domain=$_[0];
  my $DomainPath=$cli->GetDomainLocation($domain);
  unless($DomainPath) {
    print "*** Can't get domain location for $domain: ".$cli->getErrMessage."\n";
    return;
  }
  $DomainPath=~s/\\\\/\//g;
  $DomainPath = $DomainPath . '/';
  print "Domain: $domain ($DomainPath)\n";

  my $cookie="";
  do {
    my $data=$cli->ListDomainObjects($domain,5000,undef,'ACCOUNTS',$cookie);
    unless($data) {
      print "*** Can't get accounts for $domain: ".$cli->getErrMessage."\n";
      return;
    }
    $cookie=$data->[4];

    foreach(keys %{$data->[1]} ) {
      processAccountEx($domain,$_,$DomainPath);
    }
  }while($cookie ne '');
 
}

sub processAccount {
  my ($account)=@_;
  my ($user,$domain)=($account=~/(.*)\@(.*)/)[0,1];
  
  my $DomainPath=$cli->GetDomainLocation($domain);
  unless($DomainPath) {
    print "*** Can't get domain location for $domain: ".$cli->getErrMessage."\n";
    return;
  }
  $DomainPath=~s/\\\\/\//g;
  $DomainPath = $DomainPath . '/';
  processAccountEx($domain,$user,$DomainPath);
}

sub processAccountEx {
  my ($Domain,$Account,$DomainPath) = @_;


  my $AccLocation = $cli->GetAccountLocation("$Account\@$Domain");
  unless($AccLocation) {
    print "*** Can't get location for $Account\@$Domain: ".$cli->getErrMessage."\n";
    return;
  }  
  $AccLocation=~s/\\\\/\//g;
  print "Account: $Account\@$Domain ($AccLocation)\n";

  if($AccLocation=~/\.mbox$/) {
    #processMBox($BaseDir.$DomainPath,$AccLocation,"$Account\@$Domain",1); 
    print "*** won't convert a single-mailbox account\n";
    return;
  } elsif($AccLocation=~/\.mdir$/) {
    #processMDir($BaseDir.$DomainPath,$AccLocation,"$Account\@$Domain",1); 
    print "*** won't convert a single-mailbox account\n";
    return;
  } elsif($AccLocation=~/\.mslc$/) {
    #processSliced($BaseDir.$DomainPath,$AccLocation,"$Account\@$Domain",1); 
    print "*** won't convert a single-mailbox account\n";
    return;
  }
  unless(checkIfNeedToConvert($BaseDir.$DomainPath.$AccLocation,"","$Account\@$Domain")) {
    print " no need to convert this account\n";
    return;
  }

  my $oldAccessModes;
  if($disableUser) {
    my $data=$cli->GetAccountSettings("$Account\@$Domain");
    unless($data) {
      print "*** Can't get settings for $Account: ".$cli->getErrMessage."\n";
      return;
    }
    $oldAccessModes=$data->{'AccessModes'} || 'Default';
    $cli->UpdateAccountSettings("$Account\@$Domain",{ AccessModes=>'None' });  
  }
  
  processAccountEx2($Domain,$Account,$DomainPath,$AccLocation);

  if($disableUser) {
    $cli->UpdateAccountSettings("$Account\@$Domain",{ AccessModes=>$oldAccessModes });  
  }

} 

sub processAccountEx2 {
  my ($Domain,$Account,$DomainPath,$AccLocation) = @_;
  
  unless($cli->KillAccountSessions("$Account\@$Domain")) {
    print "*** Can't kill sessions for $Account\@$Domain: ".$cli->getErrMessage."\n";
    return;
  }
  $cli->SendCommand("ClearAccountCache $Account\@$Domain");

  checkDir($BaseDir.$DomainPath.$AccLocation,"","$Account\@$Domain");

  $cli->SendCommand("ClearAccountCache $Account\@$Domain");
}


sub checkIfNeedToConvert {
  my ($b,$path,$account)=@_;
  #  print "Checking dir: $b/$path\n";
  unless(opendir(DIR,"$b/$path")) {
    print "*** Can't opendir '$b/$path': $!\n";
    return 0;
  }  
  my @files = readdir(DIR);
  closedir DIR;

  foreach(@files) {
    my $fullPath="$b/".(($path) ? "$path/$_" : $_);
    if(/\.mbox$/ && -f $fullPath) {
      return 1;
    }elsif(/\.mdir$/ && -d $fullPath) {
      return 1;
    }elsif(/\.mslc$/ && -d $fullPath) {
      return 1;
    }elsif(/\.folder$/ && -d $fullPath) {
      my $res=checkIfNeedToConvert($b,($path) ? "$path/$_" : $_,$account);
      return $res if($res);
    }
  }
  return 0; 
}

sub checkDir {
  my ($b,$path,$account)=@_;
  #  print "Checking dir: $b/$path\n";
  unless(opendir(DIR,"$b/$path")) {
    print "*** Can't opendir '$b/$path': $!\n";
    return;
  }  
  my @files = readdir(DIR);
  closedir DIR;

  foreach(sort @files) {
    my $fullPath="$b/".(($path) ? "$path/$_" : $_);
    if(/\.mbox$/ && -f $fullPath) {
      processMBox($b,($path) ? "$path/$_" : $_,$account,0);
    }elsif(/\.mdir$/ && -d $fullPath) {
      processMDir($b,($path) ? "$path/$_" : $_,$account,0);
    }elsif(/\.mslc$/ && -d $fullPath) {
      processSliced($b,($path) ? "$path/$_" : $_,$account,0);
    }elsif(/\.folder$/ && -d $fullPath) {
      checkDir($b,($path) ? "$path/$_" : $_,$account);
    }
  } 
}


my ($fileNum,$writeOffset); #=(0,$slicedFileSize+1,0);
my ($rUID,$mUID,$fUID,$aUID);
my ($DATAF,$FLAGSF,$ATTRSF,$INDEXF);
my %customFlagsHash;

sub initGlobals {
  my ($path,$tempDirName)=@_;
  
  unless(reCreateDir("$path/$tempDirName")) {
    return 0;
  }
  unless(open($FLAGSF,">$path/$tempDirName/flags.mb4")) {
    print "*** can't create $path/$tempDirName/flags.mb4: $!\n";
    return 0;
  }
  unless(open($ATTRSF,">$path/$tempDirName/attributes.mb4")) {
    print "*** can't create $path/$tempDirName/attributes.mb4: $!\n";
    return 0;
  }
  unless(open($INDEXF,">$path/$tempDirName/index.mb4")) {
    print "*** can't create $path/$tempDirName/index.mb4: $!\n";
    return 0;
  }
  
  ($fileNum,$writeOffset)=(1,0);
  unless(open($DATAF,">$path/$tempDirName/data$fileNum.mb4")) {
    print "*** can't create $path/$tempDirName/data$fileNum.mb4: $!\n";
    return 0;
  }
  
  ($rUID,$mUID,$fUID,$aUID)=(0,0,0,0);
  %customFlagsHash=();
    
  1;
}

sub doneGlobals {
  my ($path,$tempDirName)=@_;
  close($DATAF);
  close($FLAGSF);
  close($ATTRSF);
  close($INDEXF);
  
  my $SETTINGSF;
  unless(open($SETTINGSF,">$path/$tempDirName/settings.mb4")) {
    print "*** can't create $path/$tempDirName/settings.mb4: $!\n";
    return 0;
  }
  syswrite($SETTINGSF,"{\015\012");
  syswrite($SETTINGSF," AttrUID=#$aUID;\015\012");
  syswrite($SETTINGSF," DelUID=#0;\015\012");
  syswrite($SETTINGSF," FlagsUID=#$fUID;\015\012");
  syswrite($SETTINGSF,"}\015\012");

  close($SETTINGSF);
}

sub hexDig {
  my ($len,$val)=@_;
  my $s=sprintf("%x",$val);
  $s=' '.$s while(length($s)<$len);
  return $s;
}

sub decDig {
  my ($len,$val)=@_;
  my $s=sprintf("%d",$val);
  $s=' '.$s while(length($s)<$len);
  return $s;
}


my @msgText;
my $msgFlags;
my $msgTimestamp;


sub writeMessage {
  my ($path,$tempDirName)=@_;

  if($msgFlags=~/^\*/) { # a service message with attributes
    my $attrs=join('',@msgText);
    $attrs=~s/[_\n\r]//g;
    $attrs.="\015\012";
    syswrite($ATTRSF, hexDig(8,++$aUID).hexDig(8,$mUID).decDig(8,length($attrs)).$attrs );
    return;
  }

  if($writeOffset>$sliceFileSize) {
    close($DATAF);
    $fileNum++;$writeOffset=0;
    unless(open($DATAF,">$path/$tempDirName/data$fileNum.mb4")) {
      print "*** can't create $path/$tempDirName/data$fileNum.mb4: $!\n";
      return;
    }
  }

  my $struct='';
  $struct=calcStructure(\@msgText);

  my $msgSize=0;
  foreach(@msgText) { $msgSize+=length($_)+2; }

  my $recA='';
  $recA.=hexDig(8,$mUID);
  $recA.='        ';
  $recA.=$msgTimestamp;
  $recA.="\015\012";    
  my $recA_h='A   '.decDig(10,length($recA))."\015\012";

  my $recS=$struct."\015\012";
  my $recS_h='S   '.decDig(10,length($recS))."\015\012";

  my $recB_h='B   '.decDig(10,$msgSize)."\015\012";

  my $recSize=length($recA)+length($recA_h)+length($recB_h)+$msgSize;
  if(length($recS)>2) { $recSize+=length($recS)+length($recS_h); }

  my $rec_h="\001\001".hexDig(8,$rUID).'  '.decDig(10,$recSize)."\015\012";

  my $msgOffset=length($rec_h)+length($recA)+length($recA_h)+length($recB_h);
  if(length($recS)>2) { $msgOffset+=length($recS)+length($recS_h); }

  syswrite($DATAF,$rec_h);
  syswrite($DATAF,$recA_h);syswrite($DATAF,$recA);
  if(length($recS)>2) { syswrite($DATAF,$recS_h);syswrite($DATAF,$recS); };    
  syswrite($DATAF,$recB_h);
  foreach(@msgText) { syswrite($DATAF,$_."\015\012"); }

  syswrite($INDEXF,sprintf("%X %d %d %d %X %d %d ",$rUID,$fileNum,$writeOffset,$recSize+length($rec_h),$mUID,$msgOffset,$msgSize).$msgTimestamp."\015\012");
  $writeOffset+=$recSize+length($rec_h);
   
  if(exists $customFlagsHash{$mUID}) {
    $msgFlags.= ' '.$customFlagsHash{$mUID};
  }  
  if(length($msgFlags)>0) {
    syswrite($FLAGSF,sprintf("%X %X $msgFlags",++$fUID,$mUID));
    syswrite($FLAGSF,"\015\012");
  } 

}



sub calcSubStruct {
  my ($msgRef,$bodyOffset,$idxStart,$idxEnd)=@_;
  my ($hSize,$bSize)=(0,0);
  my $idx=$idxStart;
  my ($c_type,$c_subtype,$c_disposition)=('','','');
  my $boundary='';
  
  while($idx<$idxEnd) {  #header
    my $l=$msgRef->[$idx];
    while($idx+1<$idxEnd) {
      my $l2=$msgRef->[$idx+1];
      if($l2 ne '' && $l2=~/^\s/) {
        $l.=substr($l2,1,length($l2)-1);
      } else {
        last;
      }
      $idx++;
    }
    if($l eq '') {
      ++$idx;
      last;
    };

    $l=~/^(.*?):\s*(.*)$/;
    my ($field,$data)=($1,$2);
    $data=~s/\(.*\)//;
    if($field=~/^Content-Disposition/) {
      $c_disposition = $data;
    } elsif($field=~/Content-Type/i) {
      $data=~/(.*?)\/(.*)/;
      $c_type=$1; $c_subtype=$2;
    }
    $idx++;
  }
  my $bodyStart=$idx;
  for(my $i=$idxStart;$i<$bodyStart;$i++) {
    $hSize+=length($msgRef->[$i])+2;
  }
  for(my $i=$bodyStart;$i<$idxEnd;$i++) {
    $bSize+=length($msgRef->[$i])+2;
  }

  my $type='P';
  if($c_disposition && $c_disposition=~/^attachment/i) {
    $type='D';
  } elsif($c_type=~/^text$/i) {
    if($c_subtype=~/^plain/i) {
      $type='P';
    } elsif($c_subtype=~/^html/i) {
      $type='H';
    } elsif($c_subtype=~/^calendar/i) {
      $type='C';
    } elsif($c_subtype=~/^(vcard|x-vcard|x-vgroup)/i) {
      $type='R';
    } elsif($c_subtype=~/^(pkcs7-signature|x-pkcs7-signature|pgp-signature)/i) {
      $type='S';
    }
  } elsif($c_type=~/^image/i) {
    $type='I';
  } elsif($c_type=~/^(x-)+audio/i) {
    $type='A';
  } elsif($c_type=~/^(x-)+video/i) {
    $type='V';
  } elsif($c_type=~/^message/i) { 
    $type='(';
  } elsif ($c_type=~/^multipart/i) {
    $type='(';
    if($c_subtype=~/boundary\s*=\s*(.*)/i) {
      my $b=$1;
      if($b=~/^(.*);/) { $b=$1;}
      if($b=~/\"(.*)\"/) { $b=$1;} #"
      $boundary=$b;
    }
  } else {
    $type='D';
  }
  my $res="$bodyOffset $hSize $bSize$type"; 
  
  if($type eq '(' && $boundary eq '') {
    return $res.calcSubStruct($msgRef,0,$bodyStart+1,$idxEnd).")";

  } elsif($type eq '(') {
    my $partStart=-1;
    my $subRes='';
    for(my $i=$bodyStart;$i<$idxEnd;$i++) {
      if($msgRef->[$i] eq "--".$boundary || $msgRef->[$i] eq "--".$boundary."--") {   
         if($partStart>0) {
           if(length($subRes)>0) { $subRes.=' '; }
           my $offset=0;
           for(my $i2=$bodyStart;$i2<$partStart;$i2++) { $offset+=length($msgRef->[$i2])+2; };
           $subRes.=calcSubStruct($msgRef,$offset,$partStart,$i);
         }  
         $partStart=$i+1;
         
      }
    }    
    return $res.$subRes.')';
  } else {
  
    return $res; 
  }
}

sub calcStructure {
  my ($msgRef)=@_;
  return calcSubStruct($msgRef,0,0,scalar(@$msgRef));
}



sub reCreateDir {
  my ($dirName)=@_;
  
  if(-d $dirName) {
    my $dh;
    unless(opendir($dh,$dirName)) {
      print "*** Can't opendir '$dirName': $!\n";
      return;
    }  
    my @files = readdir($dh);
    closedir($dh);
    foreach(@files) {
      if (-f "$dirName/$_" && !unlink("$dirName/$_")) {
        print "*** can't delete '$dirName/$_': $!\n";
      }
    }
    return 1;
  } 
  unless(mkdir($dirName)) {
    print "*** can't mkdir $dirName: $!\n";
    return 0;
  }
  1;
}


sub ConvTime {
  my ($sec,$min,$hour,$mday,$month,$year)=('00','00','00','01','01','1980');
  my %mNames=qw(Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
                Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11);

  if($_[0] =~ /(\w\w\w)\s(\d\d)\s(\d\d):(\d\d):(\d\d)\s(\d\d\d\d)/) { # Wed Oct 09 07:06:30 2002
    $month=$mNames{$1}+1;
    $month='0'.$month if(length("$month")==1);
    $mday=$2;
    $hour=$3;
    $min=$4;
    $sec=$5;
    $year=$6;
  } elsif($_[0] =~ /(\d\d)-(\d\d)-(\d\d\d\d).(\d\d):(\d\d):(\d\d)/) { # 08-03-2007_13:17:45_
    $mday=$1;
    $month=$2;
    $year=$3;
    $hour=$4;
    $min=$5;
    $sec=$6;
  }elsif($_[0] =~ /(\d{1,2}).(\w\w\w).(\d\d\d\d).(\d\d):(\d\d):(\d\d)/) {
    $mday=$1;
    $month=$mNames{$2};
    $year=$3-1900;
    $hour=$4;
    $min=$5;
    $sec=$6;
  } else {
    print "Unknown date format: $_[0]\n";
  }
  return "$year$month$mday$hour$min$sec";
  
}


sub processMBox {
  my ($path,$fName,$account,$isSingle)=@_;
  print " mbox: $fName\n";
  my $INF;
  unless(open($INF,"$path/$fName")) {
    print "*** can't open '$path/$fName': $!\n";
    return;
  }
  
  my $cutName=($fName=~/(.*)\.mbox$/)[0];
  my $tempDirName=$cutName.$tempSuffix.".mb4";
  
  return unless(initGlobals($path,$tempDirName));
  
  my $CFLAGSF;
  if(open($CFLAGSF,"$path/$cutName.flags")) {
    while(<$CFLAGSF>) {
      if( /^(\d+?) (.*)/ ) {
        $customFlagsHash{$1} = $2;
      }elsif( /^(\d+?)$/) {
        delete $customFlagsHash{$1};
      }
    }
    close($CFLAGSF);
  }


  my $line=<$INF>;
  chomp($line);
  while(!eof($INF)) {
    @msgText=();
    $msgTimestamp='';

    if($line=~/^From <.*>\((.*)\) (.*)/) {
      my ($comment,$timestamp)=($1,$2);
      $msgTimestamp=ConvTime($timestamp);
      if( $comment=~/^(.*?)-(\d+)-(\d+)/ ) {
        $msgFlags=$1;
        $rUID=0+$2;$mUID=0+$3;       
      } elsif($comment=~/^(.*?)-(\d+)/) {
        $msgFlags=$1;
        $rUID=$mUID=0+$2;
        $msgFlags=~s/_//g;
      } else {
        print "Unknown format: $line\n";
      }
    }      

    my $wasEmptyLine=1; 
    while(!eof($INF)) {
      $line=<$INF>;
      last if($wasEmptyLine && $line=~/^From <.*>\((.*)\) (.*)/);
      chomp($line);
      $wasEmptyLine=($line eq '') ? 1 : 0;
      push(@msgText,$line);
    }
        
    writeMessage($path,$tempDirName);
  }
  doneGlobals($path,$tempDirName);
  close($INF);
  
  if(-f "$path/$cutName.bdx") {
    unless(unlink("$path/$cutName.bdx")) {
      print "*** can't delete '$path/$cutName.bdx': $!\n";
      return;
    }
  }

  unless(rename("$path/$fName","$path/$fName.tmp")) {
    print "*** can't rename '$path/$fName' into '$path/$fName.tmp': $!\n";
    return;
  }
  unless(rename("$path/$tempDirName","$path/$cutName.mb4")) {
    print "*** can't rename '$path/$tempDirName' into '$path/$cutName.mb4': $!\n";
    return;
  }
  unless(unlink("$path/$fName.tmp")) {
    print "*** can't delete '$path/$fName.tmp': $!\n";
    return;
  }
  if(-f "$path/$cutName.flags") {
    unless(unlink("$path/$cutName.flags")) {
      print "*** can't delete '$path/$cutName.flags': $!\n";
      return;
    }
  }
}

sub processMDir {
  my ($path,$dirName,$account,$isSingle)=@_;
  print " mdir: $dirName\n";
  unless(opendir(DIR,"$path/$dirName")) {
    print "*** Can't opendir '$path/$dirName': $!\n";
    return;
  }  
  my @files = readdir(DIR);
  closedir(DIR);
  
  my %messages;
  my %attrFiles;
  foreach(@files) {
    if(/^(\d+)/) {
      $messages{0+$1}=$_;
    }elsif(/^O(\d+)/) {
      $attrFiles{0+$1}=$_;
    }
  }
  
  my $cutName=($dirName=~/(.*)\.mdir$/)[0];
  my $tempDirName=$cutName.$tempSuffix.".mb4";

  unless(reCreateDir("$path/$tempDirName")) {
    return;
  }

  return unless(initGlobals($path,$tempDirName));
  my $CFLAGSF;
  if(open($CFLAGSF,"$path/$dirName/flags.bdx")) {
    while(<$CFLAGSF>) {
      if( /^(\d+?) (.*)/ ) {
        $customFlagsHash{$1} = $2;
      }elsif( /^(\d+?)$/) {
        delete $customFlagsHash{$1};
      }
    }
    close($CFLAGSF);
  }

  
  foreach(sort {$a <=> $b} keys %messages) {
    $rUID=$_;
    my $fName=$messages{$_};
    if($fName=~/O(\d+)/) {
      $mUID=0+$1;
    } else {
      $mUID=$rUID;
    }
    $fName=~/\-(.+?)\-(\d+)\-(\d+)$/;
    $msgFlags=$1;
    $msgTimestamp=$2;
    $msgFlags=~s/_//g;

    my $INF;
    unless(open($INF,"$path/$dirName/$fName")) {
      print "*** can't open '$path/$dirName/$fName': $!\n";
      return;
    }
    @msgText=();
    while(!eof($INF)) {
      $line=<$INF>;
      chomp($line);
      push(@msgText,$line);
    }

    writeMessage($path,$tempDirName);
    close($INF);
  }
  
  foreach(sort {$a <=> $b} keys %attrFiles) {
    $mUID=$_;
    my $fName=$attrFiles{$_};
    $msgFlags='*';
    
    my $INF;
    unless(open($INF,"$path/$dirName/$fName")) {
      print "*** can't open '$path/$dirName/$fName': $!\n";
      return;
    }
    @msgText=();
    while(!eof($INF)) {
      $line=<$INF>;
      chomp($line);
      push(@msgText,$line);
    }
    writeMessage($path,$tempDirName);
    close($INF);
  }
  
  doneGlobals($path,$tempDirName);
  

  unless(rename("$path/$tempDirName","$path/$cutName.mb4")) {
    print "*** can't rename '$path/$tempDirName' into '$path/$cutName.mb4': $!\n";
    return;
  }
  foreach(@files) {
    if (-f "$path/$dirName/$_" && !unlink("$path/$dirName/$_")) {
      print "*** can't delete '$path/$dirName/$_': $!\n";
    }
  }

  unless(rmdir("$path/$dirName")) {
    print "*** can't delete dir '$path/$dirName': $!\n";
  }

}

sub processSliced {
  my ($path,$dirName,$account,$isSingle)=@_;
  print " mslc: $dirName\n";
  unless(opendir(DIR,"$path/$dirName")) {
    print "*** Can't opendir '$path/$dirName': $!\n";
    return;
  }  
  my @files = readdir(DIR);
  closedir(DIR);
  
  my $cutName=($dirName=~/(.*)\.mslc$/)[0];
  my $tempDirName=$cutName.$tempSuffix.".mb4";
  
  my %dataFiles;
  foreach(@files) {
    if(/^data(\d+)/) {
      $dataFiles{0+$1}=$_;
    }
  }
  
  unless(reCreateDir("$path/$tempDirName")) {
    return;
  }
  return unless(initGlobals($path,$tempDirName));
  
  my $CFLAGSF;
  if(open($CFLAGSF,"$path/$dirName/flags.bdx")) {
    while(<$CFLAGSF>) {
      if( /^(\d+?) (.*)/ ) {
        $customFlagsHash{$1} = $2;
      }elsif( /^(\d+?)$/) {
        delete $customFlagsHash{$1};
      }
    }
    close($CFLAGSF);
  }

  foreach(sort {$a <=> $b} keys %dataFiles) {
    my $INF;
    unless(open($INF,"$path/$dirName/$dataFiles{$_}")) {
      print "*** can't open '$path/$dirName/$dataFiles{$_}': $!\n";
      return;
    }

    my $line=<$INF>;
    chomp($line);
    while(!eof($INF)) {
      @msgText=();
 
      if($line=~/^\001\001\001\d (\d+) (\d+) (\d+) (.*)/) {
        $rUID=0+$1;$mUID=0+$2;
        $msgFlags=$4;
        $msgTimestamp=$3;        
        $msgFlags=~s/_//g;
      } else {
        print "Unknown format: $line\n";
      }
  
      while(!eof($INF)) {
        $line=<$INF>;
        chomp($line);
        last if($line=~/^\001\001\001/);
        #$line.="\015\012";
        push(@msgText,$line);
      }
          
      writeMessage($path,$tempDirName);
    }
    close($INF);
  }
  doneGlobals($path,$tempDirName);
  
  unless(rename("$path/$tempDirName","$path/$cutName.mb4")) {
    print "*** can't rename '$path/$tempDirName' into '$path/$cutName.mb4': $!\n";
    return;
  }
  foreach(@files) {
    if (-f "$path/$dirName/$_" && !unlink("$path/$dirName/$_")) {
      print "*** can't delete '$path/$dirName/$_': $!\n";
    }
  }
  unless(rmdir("$path/$dirName")) {
    print "*** can't delete dir '$path/$dirName': $!\n";
  }

}

__END__

