Post by P***@Chicago.netI have one installation of Eudora on my PC - but two locations for the
data and settings. I'd like to try using Thunderbird and want to import
my data. However, the location my data is in is not the default
location. Therefore, when Thunderbird imports the Eudora data, it goes
automatically to the default location and doesn't give me a chance to
specify that I want it to go to another location. How do I do what I
want to accomplish?
How advanced are your computer skills?
I have a script that was used by us (the University of Oslo) when we
converted our users from Eudora to Thunderbird.
This ranged from Eudora Light 1.5.x (which have a slightly different
mbx-format), users using both pine & Eudora, users insisting that Eudora
3.x was far better and modern Eudora users.
It is written in perl and you will need a perl instance.
Usage
perl <script> <from_folder> <to_folder>
Exampel: perl.exe hf_mbxmaker.pl e:\DivTemp\Thunderbird\from\
e:\DivTemp\Thunderbird\converted\
Use a copy of the folder you want to convert
the script (cut here ---- >
#!/local/bin/perl5
# Current changes needed:
# Remove the ambiguous <x-flowed> and </x-flowed> tags. (OK?)
# <x-flowed>
# body
# </x-flowed> (line ~= /<\/x-flowed>//?)
# --- DONE ---
# Less urgent:
# Header/tag: All html mail that are sent from Eudora, don't get a
# 'Content-Type' field. All such mails are therefore shown as plain text
# in M/T. To fix this: Add the header 'Content-Type: text/html' (if it
# doesn't exists).
# --- DONE --- Men, brukte text/plain istedet for text/html, siden jeg
fant gamle eposte uten content-type som var i plain-format (gnumailer)
# Create gui?
# If tag <x-html> until </x-html> remove :
# until </HEAD> all
# after all <.*> and </.*> leave only text
chdir("c:\\temp");
use File::Find;
use Cwd;
use Time::Local;
use Time::Local 'timelocal_nocheck';
use Getopt::Long;
use strict;
my $start_epoch = time; print "Starttid: $start_epoch\n";
my $current_directory = getcwd;
for (my $i=0; $i <= $#ARGV; $i++) {
if ( $ARGV[$i] =~m|^\./*(.*)| or $ARGV[$i] =~ m|^[\\/](.*)| ) {
$ARGV[$i] = $current_directory . '/' . $1;
}
$ARGV[$i] =~ s|[/\\]$||; # Stripping trailing slashes/backslashes
}
my ($gsInpath, $gsUtpath, $help);
$help = 0;
my $debug = 0;
# Leser inn argumenter på en fornuftig måte:
GetOptions(
"inputpath=s" => \$gsInpath,
"outputpath=s" => \$gsUtpath,
"help|?" => \$help,
"debug" => \$debug
);
if ( scalar(@ARGV) > 2) {$help = 1; print scalar(@ARGV) . '
argumenter...\n';}
if ( $help ) {
print_help();
exit;
}
# Defaultstier hvis ikke oppgitt på kommandolinje
$gsInpath = 'm:/pc/eudora' unless defined($gsInpath);
# Setter utpath til noe "ufarlig" i tilfelle feil bruk av prog:
$gsUtpath = 'm:/pc/konvertert/Mail/Local Folders' unless defined($gsUtpath);
for (@ARGV) { print 'ARG: ' . $_ . "\n"; }
# Litt argument-massering:
if ( scalar(@ARGV) > 0 ) { # Hvis ingen argumenter brukes default
if ( scalar(@ARGV) == 1 ) {
$gsUtpath = $ARGV[0]; # Hvis bare ett argument er oppgitt brukes
det som destination
$gsUtpath =~ s|\\|/|g;
} else {
$gsInpath = $ARGV[0];
$gsInpath =~ s|\\|/|g;
$gsUtpath = $ARGV[1];
$gsUtpath =~ s|\\|/|g;
}
}
print "Checking/creating destination folder '$gsUtpath'...\n";
if ( opendir(DIR, $gsUtpath) ) {
print "'$gsUtpath' exists, no need to create one...\n";
} else {
if ( mkdir_recursive($gsUtpath) ) {
print "Created '$gsUtpath'\n";
} else {
print "Could not create '$gsUtpath', check path or create folder
manually...\n";
die;
}
}
print "Opening source folder '$gsInpath'...\n";
if ( not opendir(DIR, $gsInpath) ) {
die "Could not open source folder... Bye!\n";
}
closedir(DIR);
print "*******************************************\nSetter igang
traversering av '$gsInpath'\n" if $debug;
find(\&process_tree, $gsInpath);
my $slutt_epoch = time();
my $timeconsume = $slutt_epoch - $start_epoch;
my ($days, $hours, $minutes, $seconds);
my $teksttidsrom;
$seconds = $timeconsume % 60;
if ($seconds) { $teksttidsrom = lag_tidstekst("sekund", "sekunder",
$seconds); }
$timeconsume = ($timeconsume - $seconds) /60;
$minutes = $timeconsume % 60;
if ( $minutes ) { $teksttidsrom = lag_tidstekst('minutt', 'minutter',
$minutes) . ", " . $teksttidsrom; }
$timeconsume = ($timeconsume - $minutes) / 60;
$hours = $timeconsume % 24;
if ( $hours ) { $teksttidsrom = lag_tidstekst("time", "timer", $hours) .
", " . $teksttidsrom; }
$timeconsume = ($timeconsume - $minutes) / 24;
$days = $timeconsume % 7;
if ( $days ) { $teksttidsrom = lag_tidstekst("dag", "dager", $days) .
", " . $teksttidsrom; }
print "Ferdig med konvertering av alle postkassene, brukte $teksttidsrom\n";
exit;
sub lag_tidstekst {
my $entall = shift;
my $flertall = shift;
my $antall = shift;
if ($antall > 0) {
if ( $antall == 1 ) {
return $antall . " " . $entall;
} else {
return $antall . " " . $flertall;
}
} else {
return '';
}
}
sub process_tree {
# Hvis fil -> prosesser
# Hvis mappe -> lag
my $filnavn = $_; # Bruker lower case just to make sure (?)
my $filkomplett = change_backslash($File::Find::name);
my $filsti = change_backslash($File::Find::dir);
my $top = change_backslash($File::Find::topdir);
my $destmappe;
if ( -d $filkomplett ) { # Har her funnet mappe...
if ( $filnavn =~ /\.fol$/ ) { # Her har vi funnet ei mappe med
mailbokser!
print "++++++++++++++++++++++++ Ny mappe ++++++++++++++++++++++++\n"
if $debug;
print "Skal nå prosessere '$filkomplett'\n";
$destmappe = construct_destinationpath($filsti, $top); # Lager
destinasjonssti, i tilfelle den trengs... :-)
return 0 if not $destmappe;
# En typisk sti: M:/pc/eudora/nothingp.fol/Racing.fol
# Skal bli: M:/pc/thunderbird/nothingp.sbd/Racing.sbd
# Her skal det opprettes samme struktur i target-mappa, men
.fol-suffix skal strippes av først, og .sbd skal legges på:
print "\tDestinasjonsmappe: $destmappe\n";
print "\tFilsti: $filsti\n";
my $basefilename = $filnavn;
$basefilename =~ s|\.fol$||; # Skal ikke ha .fol i endelsen av
verken mbx eller mappe
print "\tFant eudora-mappe med mailboxer ($filkomplett)... Oppretter
tilsvarende mappe på destination ($destmappe)\n";
# Mappe må lages:
if ( not lag_mappe($destmappe, $basefilename . '.sbd', $basefilename) ) {
print "\tFikk ikke laga mappe eller tom mailbox!\n";
}
} elsif ( $File::Find::name ne $File::Find::topdir ) { # Skal ikke
prune m:\pc\eudora!
$File::Find::prune = 1;
}
} elsif ( $filnavn =~ /\.mbx$/ ) { # Her har vi funnet en fil...
print "++++++++++++++++++++++++ Ny fil ++++++++++++++++++++++++\n" if
$debug;
print "Skal nå prosessere '$filkomplett'\n" if $debug;
$destmappe = construct_destinationpath($filsti, $top); # Lager
destinasjonssti, i tilfelle den trengs... :-)
# Kjør konverteringsrutine!
# Graver ut destinasjon for konverteringa...:
# Stripper vekk .mbx:
my $bart_filnavn = $filnavn;
$bart_filnavn =~ s|\.mbx$||; # Fjerner suffix, bare filnavnet
brukes oftere enn eudora-navnet!
print "\tFant postkasse ( $filnavn )\n" if $debug;
print "\tKomplett navn for konvertert postkasse blir
'$destmappe/$bart_filnavn'\n" if $debug;
konverter_mbx($bart_filnavn, $filsti, $destmappe); # Sender med
relativ (til $inpath) sti OG filnavn...
}
}
sub les_toc {
my $fh = shift;
my (@tocdates, @resten);
my $i = 0;
# Leser inn og parser toc-fila:
while (my $line=<$fh>) {
#print "Leser ny linje, linja er " . length($line) . " lang...\n";
my $parserounds = 0;
#print_charnumbers($line);
while ( $line =~ m|(\d\d:\d\d\s+\d\d\.\d\d\.\d{4}(\s+[-+]?\d{4})?)(.*)| ) {
#print_charnumbers($line);
$parserounds++;
#print "Fant dato i TOC (runde " . $parserounds . ")!: ";
#print "Parser linje i tocfila ( lengde " . length($line) . " ):\n";
$line = $3; # Resten av linja skal prosesseres!
#print "Resten av strengen:\n";
#print_charnumbers($line);
$tocdates[$i] = $1;
$i++;
}
}
return @tocdates;
}
sub konverter_mbx { # Modifisere denne til å ta full sti
relativ til $inpath...
my $filenamebase = shift; # Navn på postkasse, uten suffix!
my $sourcepath = shift; # Absolutt sti til mappa med mailboksen som
skal konverteres
my $destpath = shift; # Absolutt sti til mappe det skal konverteres til!
my $mbxfilename = $filenamebase . '.mbx';
my $tocfilename = $filenamebase . '.toc'; # TOC-filnavn
print "konverter_mbx: Filebase for konvertering: $filenamebase\n" if $debug;
my $i = 0;
my $notoc = 0;
# Åpner TOC-fila til mailboksen:
opendir(DIR, $sourcepath);
my $fhtoc = *TOC;
my @tocdates;
if ( not open($fhtoc, "<$tocfilename") ) {
$notoc = 1;
print "konverter_mbx: Kunne ikke åpne tocfila ($tocfilename)\n";
} else {
@tocdates = les_toc($fhtoc);
close TOC;
print "konverter_mbx: Fikk åpna tocfila ($tocfilename) for mbx'en
($mbxfilename)\n";
}
my (@mbxdates, @mbxmailstarts, @mbxeverything);
my ($di, $fi, $si, $body, $newmail, $start)=(0,0,0,0,0,0);
$i=-1;
my $fhmbx = *MBX;
# Skal så lese inn mbx-fila for å konvertere...:
open($fhmbx, "<$mbxfilename") or print "Kunne ikke åpne fila
'$filenamebase'\n";
if ( not parse_mbx($fhmbx, \@mbxeverything, \@mbxdates, \@mbxmailstarts) ) {
print "Fikk ikke prosessert '$mbxfilename'...\n";
return 0;
} else {
print "Har prosessert '$mbxfilename'\n";
}
close $fhmbx;
closedir(DIR);
# Skal nå lage den nye postkassa:
my @mbx = MbxFromToc($notoc, \@mbxdates, \@tocdates, \@mbxmailstarts,
\@mbxeverything);
@tocdates=[];
@mbxeverything=[];
my $targetfilename = $destpath . '/' . $filenamebase;
open(UTFIL,">$targetfilename") or print "Kunne ikke åpne utfil
($targetfilename)\n";
chomp @mbx;
for (@mbx) { print UTFIL ($_) . "\n"; } # Må legge til \n på windows,
tydeligvis... grumle
close UTFIL;
}
sub parse_mbx {
my $fh = shift;
my $arrmbxeverything = shift; # Peker til array med alle linjer
fra epost...
my $arrmbxdates = shift;
my $arrmbxmailstarts = shift;
my $i = -1;
my $body = 0; # 1 - i body, 0 - ikke...
my $start = 0; # Indeks i array med startlinjenummer
my $di = 0; # Indeks i array med dates...
# Skal så lese inn mbx-fila for å konvertere...:
my $contenttypeline = 0;
my $iFromLine = 0; # Linjenummeret til From: i header
my $sXFrom = undef; # Innholdet i X-From_-feltet i header (kjip
exchange-ting)
my $sFrom = undef; # Innholdet i From-feltet i header...
my $iSubjectLine;
my $verbose = 0;
while( my $line =<$fh>) {
# Preprossessering:
# printf("%-20s: body = %4d: %s\n", "Prosesslinje", $body,
print_linechars($line)) if $debug;
$line =~ s|</?x-flowed>||g; # Obsolete tag...
$i++; # Linjeteller...
print "parse_mbx: Linje: $line" if $verbose;
print "parse_mbx: contenttypeline = $contenttypeline, iFromLine =
$iFromLine\n" if $verbose;
if ( $line =~ m/From\ \?\?\?@\?\?\?\ Tue\ May\ 10\ 09:01:00\ 2005/ ) {
$verbose = 1; }
if ($line =~ m/^>?From\s*-?\s*\?\?\?@\?\?\?.*/) { # Hvis From -> Ny
epost...
$line =~ s/^>//; # Eudora legger en > i begynnelsen på
From-linja: ARRRRGHHH!!!
if ( $i>0 ) { # Legger til ekstra linjeskift på slutten av
(linja foran neste epost)
$$arrmbxeverything[$i] = "\n";
$i++;
}
$$arrmbxmailstarts[$start]=$i; # Starten på
$body=0; # Vi er i header, markerer med body=0
$contenttypeline = 0; # Linjenummer for contenttype settes til 0
$iSubjectLine = 0;
$sXFrom = undef;
$iFromLine = 0;
$start++; # marker slutt på body, sett +mailstarts =
linjenummer, startindex++
} elsif ( $line =~ /(.+)\r\n$/ ) { # Noen klienter putter på en
\r i content-line-feltet....
$line = $1 . "\n"; # Denne er ikke robust på kryss av OS....
} elsif ( (lc($line) =~ m|^\s*boundary=| or lc($line) =~ m|^\s*line=|)
and $contenttypeline == ($i-1) ) {
# Sjekker spesialtilfellet hvor boundary har fått egen linje etter
content-type (MAC, først og fremst, tilsynelatende...)
print "parse_mbx: Fant ei linje med ekstra linjer med unyttig info
etter content-type\n" if $debug;
print "Contenttypeline = $contenttypeline, i = $i\n" if $debug;
$i--; # Skrur tilbake for å fjerne linja totalt....
next;
} elsif ( not ( $iFromLine or $contenttypeline or $iSubjectLine) and
$line =~ /^\n/ and not $body ) {
print "parse_mbx: Fant blank linje i header (før From, Content-Type
eller Subject), sletter!\n";
$i--;
next;
}
#printf("%-20s: body = %4d: %s\n", "Preprosessering", $body,
print_linechars($line)) if $debug;
$$arrmbxeverything[$i] = $line; # Legger linje fra mbx i "array
med alt"
# Postprosessering:
if ($line =~ m/^Date:\s(.*)/ and not $body) { # Hvis linje er en
dato...
if ($body eq 1) { next;} else { $$arrmbxdates[$di]=$1; $di++; next; }
# Les neste linje hvis vi er i body... Ellers legg dato til @dates og
datoindex++...
} elsif ( lc($line) =~ m|^\s*x\-from\_:\s*(\S+)\s*| and not $body) {
print "Fant linje med X-From_-header! Plukker ut epostadressa ($1)\n"
if $debug;
$sXFrom = $1;
} elsif ( lc($line) =~ m/from:\s*(\S+)\s/ ) {
$sFrom = $1;
$iFromLine = 1;
} elsif ( lc($line) =~ m|subject:\s*\S*| ) {
$iSubjectLine = $i;
} elsif ($line =~ m/^[\r]?\n/ or $line =~ m/^\r/ ) { # Hvis linje
*begynner* med \n eller \r\n:
$verbose = 0;
$body=1; # Body begynner
if ( not $contenttypeline ) { # Spesialbehandling av mangel på
content-type (eudora-html-mail)...
my $temp = $$arrmbxeverything[$i];
$$arrmbxeverything[$i] = 'Content-Type: text/plain';
$contenttypeline = $i;
$i++;
$$arrmbxeverything[$i] = $temp;
# print "parse_mbx: Satt inn Content-Type på linje $i\n";
next;
}
if ( defined($sXFrom) ) { # Hvis det foreligger en XFrom-linje i
header:
# print "X-From er definert...\n" if $debug;
if ( not $sFrom ) {
# print "From-feltet er tomt!\n" if $debug;
if ( $iFromLine ) {
#print "Header inneholder From-felt, setter inn '$sXFrom' på
From-linja ($iFromLine) i stedet\n" if $debug;
$$arrmbxeverything[$iFromLine] = "From: " . $sXFrom; # Lag en ny
From:-linje siden den mangler;
} else {
#print "Header inneholder ikke From-felt, setter inn '$sXFrom' på
slutten av headern (linje $i)\n" if $debug;
my $temp = $$arrmbxeverything[$i];
$$arrmbxeverything[$i] = "From: " . $sXFrom;
$i++;
$$arrmbxeverything[$i] = $temp;
}
}
}
} elsif ( lc($line) =~ m/^content-type:\s*(.*)/ ) { # Håndterer
spesialtilfellet at eposten har inneholdt et vedlegg
$contenttypeline = $i;
if ( lc($1) =~ m|^multipart/| ) {
$$arrmbxeverything[$i] = 'Content-Type: text/plain'; # Setter inn
standard content-type istedet for vedlegg -> spesialformat
}
} elsif ( $body && $line =~ m/^<(x-)?html>/ ) { # Bekreftelse på at
body er i html...
$$arrmbxeverything[$contenttypeline] = 'Content-Type: text/html';
}
#printf("%-20s: body = %4d: %s\n", "postprosessering", $body,
print_linechars($$arrmbxeverything[$i])) if $debug;
}
return 1;
}
sub MbxFromToc {
my $no_toc = shift; # 1 hvis ingen toc, 0 ellers...
my $arrMbxDates = shift; # Array med Datoer fra Toc-fila...
my $arrTocdates = shift; # Array med Datoer fra MBX-fila
my $arrStarts = shift; # Array med linjenummer for start for hver
epost...
my $arrEverything = shift; # Array med alle data fra mbx'en...
my %seen;
my $treff; # answer
my $item;
my $hd;
my $tocsize = scalar(@$arrTocdates); # Antall elementer i date-arrayet...
my $mbxsize = scalar(@$arrMbxDates); # Trekker fra en pga
0-indeksering i arrays...
my @mbx; # Array med linjer som skal skrives til fil...
my @hdato; # Array med datoer fra mbx
print "MbxFromToc: Antall poster i toc: " . scalar(@$arrTocdates) . "\n";
print "MbxFromToc: Antall poster i mbx: " . scalar(@$arrMbxDates) . "\n";
if ( $no_toc ) {
print "toc_ut: TOC-fil mangler: Bruker parsert mbx mot målfil\n";
chomp(@$arrEverything);
return @$arrEverything;
} else {
print "toc_ut: TOC-fil foreligger for mbx-fil...\n";
if ( $tocsize <= 0) {
print "toc_ut: Fant ingen poster i toc-fila: Bruker parsert mbx mot
målfil\n";
chomp(@$arrEverything);
return @$arrEverything;
} else {
if ($tocsize == $mbxsize or $mbxsize < $tocsize) { # Hvis antall
elemeter i Date-array er lik antall elementer i Headerarray dumpes hele
greia ut
print "toc_ut: tocsize = mbxsize, mbxsize < tocsize, eller ingen
tilhørende toc-fil... Legger ut mbx direkte...\n";
chomp @$arrEverything; # Fjern newlines, og dump til mbx-array -
Hva med avslutning av epost?
return @$arrEverything;
} else { # Her er tocsize <> mbxsize
print "toc_ut: Antall elementer i toc-array er ikke lik antall
elementer i mbx-array, vi kjører ut epost fra toc-tabellen...\n";
chomp @$arrMbxDates;
# Noterer "dates" for alle mbxdates i en hash som "seen":
my $c = 0;
foreach $item (@$arrTocdates) {
$c++;
$seen{$item} = 1;
# printf("%4d: %-20s: %-40s\n", $c, "toc_ut: La til tocdato:",
"'$item'");
} # ditem = 19:40 03.12.2003 +0100
#print "MbxFromToc: Kjører gjennom samtlige dato-headere fra mbx:\n";
#printf("'%-25s', '%-20s', '%-25s'\n", "Dato med tidssone", "Justert
dato", "Justert dato med tidssone");
for ( my $hd = 0; $hd < $mbxsize; $hd++ ) {
# lager de tre variantene av datoer som kan forekomme i mbx/toc
my $date_formatted_tz = format_date($$arrMbxDates[$hd], 1); #
Lager key for å fylle match-hash fra toc-filas
my ($tz, $date_formatted) = get_tz($date_formatted_tz);
my $date_formatted_adj = adjust_date($date_formatted_tz, $tz);
my $date_formatted_adj_tz = $date_formatted_adj . " " . $tz;
#printf("%4d: %-25s, %-20s, %-25s: ", $hd, "'$date_formatted_tz'",
"'$date_formatted_adj'", "'$date_formatted_adj_tz'");
if ( $seen{$date_formatted_tz} or $seen{$date_formatted_adj} or
$seen{$date_formatted_adj_tz} or $seen{$date_formatted} ) {
$treff++;
my $first = $$arrStarts[$hd];
my $last = $$arrStarts[$hd+1] -1; # En epost varer til linja
foran neste, pr. definisjon...
push(@mbx, @$arrEverything[$first..$last]);
#print "<Fant!!!>\n";
} else {
#print "<Fant ikke!!!>\n";
}
}
print "toc_ut: Antall mbxheadere med dato som matcher toc-dato: " .
$treff . "\n";
return @mbx;
}
}
}
}
sub get_tz {
my $datetime = shift;
if ( $datetime =~ m|(\d\d:\d\d\s+\d\d\.\d\d\.\d{4})\s+([-+]?\d{4})| ) {
return $2, $1;
} else {
return $datetime, "";
}
}
sub adjust_date {
my $datetime = shift; # Juster datetime med timezone...
my $timezone = shift;
# Gjør om datetime til epoch
# Plukk ut sentrale ting:
# 11:05 19.01.2005
if ( $datetime =~ m|(\d\d):(\d\d)\s+(\d\d)\.(\d\d).(\d{4})| ) {
my ($year, $month, $mday, $hour, $minutes);
$hour = $1;
$minutes = $2;
$mday = $3;
$month = $4;
$year = $5;
my $epochadj;
my $epochbase = timelocal_nocheck(0, $minutes, $hour, $mday, $month,
$year); # Feiler ikke på ulogiske datoer...
my $sign;
my $tzhours;
my $adj;
my $adj_seconds;
#Finner så timezone-saken:
if ( $timezone =~ m|([+-]?)(\d\d)00| ) {
$sign = $1;
$tzhours = $2;
$tzhours =~ s|^0*||;
$adj = eval($sign . $tzhours);
$adj_seconds = $adj * 3600;
$epochadj = $epochbase + $adj_seconds;
my ($mi, $h, $md, $mo, $year) = (localtime($epochadj))[1..5];
$year = $year + 1900;
my $tzadjusted = sprintf("%02d:%02d %02d.%02d.%4d", $h, $mi, $md, $mo,
$year);
return $tzadjusted;
} else {
return $datetime;
}
} else {
return 0;
}
}
sub format_date {
my $date = shift;
my $timezone = shift;
my $month;
my $day;
if ($date =~
m/.*,\s+(\d+)\s+(.*)\s+(\d{4})\s+(\d\d:\d\d):\d\d\s+(.\d{4}).*/) {
$day = $1;
if (length $day eq 1) {$day = "0".$day;}
$month = $2;
if ($month eq "Jan") { $month = "01";}
elsif ($month eq "Feb") { $month = "02";}
elsif ($month eq "Mar") { $month = "03";}
elsif ($month eq "Apr") { $month = "04";}
elsif ($month eq "May") { $month = "05";}
elsif ($month eq "Jun") { $month = "06";}
elsif ($month eq "Jul") { $month = "07";}
elsif ($month eq "Aug") { $month = "08";}
elsif ($month eq "Sep") { $month = "09";}
elsif ($month eq "Oct") { $month = "10";}
elsif ($month eq "Nov") { $month = "11";}
elsif ($month eq "Dec") { $month = "12";}
if ( $timezone ) {
return "$4 $day.$month.$3 $5"; # Lager key for å fylle match-hash
fra toc-filas
} else {
return "$4 $day.$month.$3"; # returnerer både med og uten
tidssoneangivelse...
}
} else {
return 0;
}
}
sub construct_destinationpath { # Forutsetning: At stier bruker
slash....
my $srcpath = shift; # Komplett sti som skal parses
my $top = shift; # Topp-katalog som er referense til relativ sti...
# En typisk sti: M:/pc/eudora/nothingp.fol/Racing.fol
# Skal bli: M:/pc/thunderbird/nothingp.sbd/Racing.sbd
my $relativsti = get_relativepath($srcpath, $top);
$relativsti =~ s|\.fol|\.sbd|g; # .fol-suffiks skal *ikke* inngå i
sti til destinasjon
my $dest;
print "construct_destinationpath: Relativsti: '$relativsti'\n" if $debug;
if ( $relativsti ne '.' ) {
$dest = $gsUtpath . '/' . $relativsti; # NB: gsUtpath er global,
derav navnet ;-)
} elsif ( not $relativsti ) {
print "construct_destinationpath: '$srcpath' inngår ikke i filtreet
'$top'\n" if $debug;
return 0;
} else {
$dest = $gsUtpath; # Når $relativesti er tom skal det ikke
brukes slash mellom...
}
# print "get_destination: Returnerer '$dest'\n";
return $dest;
}
sub get_relativepath { # Antar case insensitive...
my $fullpath = shift;
my $reference = shift;
print "get_relativepath: Fullpath: $fullpath, Reference: $reference\n"
if $debug;
if ( $fullpath =~ m|$reference/*(.*)$| ) { # Plukker ut relative
sti uten leading slash
if ( not length($1) ) {
print "get_relativpath: Returnerer '.'\n" if $debug;
return '.';
} else {
print "get_relativpath: Returnerer $1\n" if $debug;
return $1;
}
} else {
print "get_relativepath: Ikke treff!\n" if $debug;
return 0;
}
}
sub change_backslash {
my $string = shift;
$string =~ s|\\|/|g;
return $string;
}
sub change_slash {
my $string = shift;
$string =~ s|/|\\|g;
return $string;
}
sub mkdir_recursive {
my $sti = shift;
my @elementer = reverse split(m|\/|, $sti);
my $curr = pop(@elementer);
while ( my $ledd = pop(@elementer) ) {
$curr .= '/' . $ledd;
print "Lager '$curr'...\n" if $debug;
if ( not ( -d $curr or mkdir($curr, 700) ) ) {
print "nix...\n" if $debug;
return 0;
}
}
return 1;
}
sub lag_mappe {
my $sti = shift;
my $mappenavn = shift;
my $mbxnavn = shift;
print "lag_mappe: Skal lage mappa '$mappenavn' og fila '$mbxnavn' i
'$sti'...\n" if $debug;
if ( opendir(CURRENT, $sti) ) {
print "Fikk åpna mappa '$mappenavn'\n" if $debug;
my $mappe = $sti . '/' . $mappenavn;
if ( mkdir($mappe, 700) ) {
print "lag_mappe: Fikk lagd $mappe i $sti\n" if $debug;
my $mbx = $sti . '/' . $mbxnavn;
if ( open(OUT, '>' . $mbx) ) {
print "lag_mappe: Fikk lagd $mbx i $sti\n" if $debug;
close OUT;
closedir(CURRENT);
return 1;
} else {
print "lag_mappe: Fikk IKKE lagd $mbx i $sti\n" if $debug;
closedir(CURRENT);
return 0;
}
}
} else {
print "lag_mappe: Fikk ikke åpna $sti\n" if $debug;
return 0;
}
}
sub print_help {
print "NAME\n\tmbxmaker - Convert eudora mbx mailbox tree to thunderbird
unix mbx tree\n\n";
print "SYNOPSIS\n\tmbxmaker [OPTION]...\n\n";
print "DESCRIPTION\n\tConverts all eudora mailboxes in a eudora file
tree to standard unix mailboxes in a thunderbird tree.\n\n";
print "\t-i INPUTPATH, --inputpath=INPUTPATH\n\t\tPath to root of file
tree to be converted. Default path is 'm:\\pc\\eudora'\n\n";
print "\t-o OUTPUTPATH, --outputpath=OUTPUTPATH\n\t\tSets target root
path to OUTPUTPATH. Default path is 'm:\\pc\\converted\\Mail\\Local
Folders'\n\n";
print "\t-d, --debug\n\t\tDisplay lots and lots of debug information\n\n";
print "\t-?, -h, --help\n\t\tPrint this...\n\n";
}
sub print_charnumbers {
my $string = shift;
for my $tegn (split(//, $string)) {
my $nr = ord($tegn);
if ( ( $nr >= 46 and $nr <= 90 ) or ( $nr >= 97 and $nr <= 122 ) ) {
printf("Nr.: %4d - Tegn: %-3s\n", $nr, $tegn);
} elsif ( $nr = 32 ) {
printf("Nr.: %4d - Tegn: %-3s\n", $nr, "<space>");
} else {
printf("Nr.: %4d\n", $nr);
}
}
}
sub print_linechars {
my $string = shift;
my @chars = split (//, $string);
my $return;
for (@chars) {
if ( /\n/ ) { $return .= "<newline>"; }
elsif ( /\r/ ) { $return .= "<return>"; }
else { $return .= $_; }
}
return $return;
}
<--- cut here
Regards/
JarrE