tools/outlook2claws-mail.pl

   1 #!/usr/bin/perl -w
   2
   3 # Copyright 2002-2003 Ricardo Mones <ricardo@mones.org>
   4 #
   5 # This file is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18 #
  19 # outlook2claws-mail.pl -- perl script to convert an Outlook generated
  20 #                          contact list into a Claws Mail XML address book.
  21 #
  22 # This script is based on:
  23 #       out2syl.sh by Rafael Lossurdo <mugas@via-rs.net>
  24 #       kmail2claws-mail.pl by Paul Mangan <paul@claws-mail.org>
  25 #
  26 # See README file for details and usage.
  27 #
  28
  29 $nboffields = 28;       # change this only if you did read README
  30
  31 # parse parameters
  32 $do_csv = 0;
  33 die "Error: required filename missing\n" unless (defined($ARGV[0]));
  34 $_=$ARGV[0];
  35 if (/--csv/) {
  36         die "Error: required filename missing\n" unless (defined($ARGV[1]));
  37         $do_csv = 1;
  38         $outl_file = $ARGV[1];
  39 }
  40 else {
  41         $outl_file = $ARGV[0];
  42 }
  43 # some init
  44 $clawsconf = ".claws-mail/addrbook";
  45 $indexname = "$clawsconf/addrbook--index.xml";
  46
  47 # the next is mostly Paul's code
  48 $time = time;
  49
  50 chdir;
  51 opendir(CLAWS, $clawsconf) || die("Error: can't open $clawsconf directory\n");
  52         push(@cached,(readdir(CLAWS)));
  53 closedir(CLAWS);
  54
  55 foreach $cached (@cached) {
  56         if ($cached =~ m/^addrbook/ && $cached =~ m/[0-9].xml$/) {
  57                 push(@addr, "$cached");
  58         }
  59 }
  60
  61 @sorted = sort {$a cmp $b} @addr;
  62 $last_one = pop(@sorted);
  63 $last_one =~ s/^addrbook-//;
  64 $last_one =~ s/.xml$//;
  65 $last_one++;
  66 $new_book = "/addrbook-"."$last_one".".xml";
  67
  68 # some subs
  69 # warning: output file is global
  70 sub write_header {
  71         print NEWB "<?xml version=\"1.0\" encoding=\"US-ASCII\" ?>\n";
  72         print NEWB "<address-book name=\"Outlook Address Book\" >\n";
  73 }
  74
  75 sub write_footer {
  76         print NEWB "</address-book>\n";
  77 }
  78
  79 sub write_person_h {
  80         my($fn, $ln, $nn, $cn) = @_;
  81         # one of them must be given
  82         if (($fn eq "") and ($ln eq "") and ($nn eq "") and ($cn eq "")) {
  83                 $cn = "No name provided";
  84                 # but return may break XML structure
  85         }
  86         print NEWB "  <person uid=\"", $time++, "\" first-name=\"", $fn, "\" ";
  87         print NEWB "last-name=\"", $ln, "\" nick-name=\"", $nn, "\" cn=\"", $cn, "\" >\n";
  88 }
  89
  90 sub write_person_f {
  91         print NEWB "  </person>\n";
  92 }
  93
  94 sub write_addrlist_h {
  95         print NEWB "    <address-list>\n";
  96 }
  97
  98 sub write_addrlist_f {
  99         print NEWB "    </address-list>\n";
 100 }
 101
 102 sub write_address {
 103         my($al, $em, $re) = @_;
 104         if ($em eq "") {
 105                 $em = "No e-mail address";
 106                 # email is a must -> no address breaks claws-mail display
 107                 # (claws-mail says file is ok but no name is shown)
 108                 # maybe this is a bug on claws-mail?
 109         }
 110         print NEWB "      <address uid=\"", $time++, "\" ";
 111         print NEWB "alias=\"", $al, "\" email=\"", $em, "\" remarks=\"", $re, "\" />\n";
 112 }
 113
 114 sub write_attrlist_h {
 115         print NEWB "    <attribute-list>\n";
 116 }
 117
 118 sub write_attrlist_f {
 119         print NEWB "    </attribute-list>\n";
 120 }
 121
 122 sub write_attribute {
 123         my($aname, $aval) = @_;
 124         if (($aname eq "") or ($aval eq "")) { return; } # both are must
 125         print NEWB "      <attribute uid=\"", $time++, "\" ";
 126         print NEWB "name=\"", $aname, "\" >", $aval, "</attribute>\n";
 127 }
 128
 129 sub process_text {
 130         write_header();
 131         $count = 0;
 132         while (<OUTL>) {
 133                 chomp;
 134                 if (/\s+[0-9]+\s+(.+)/) { $_ = $1; }
 135                 else { $count += 2 and die "Error: wrong format at line $count \n"; }
 136                 @field = split(/;/); # first is name, second mail addr
 137                 write_person_h("","","",$field[0]);
 138                 write_addrlist_h();
 139                 $field[1] =~ s/\r//; # beware, dangerous chars inside ;)
 140                 write_address("",$field[1],"");
 141                 write_addrlist_f();
 142                 write_person_f();
 143                 ++$count;
 144         }
 145         write_footer();
 146 }
 147
 148 sub process_csv {
 149         write_header();
 150         $count = 0;
 151         while (<OUTL>) {
 152                 chomp;
 153                 # do something useful: quote XML chars
 154                 s/\&/&amp;/g;
 155                 s/\</&lt;/g;
 156                 s/\>/&gt;/g;
 157                 s/\'/&apos;/g;
 158                 s/\"/&quot;/g;
 159                 @field = split(/,/);
 160                 if ($#field != $nboffields) { $count += 2 and die "Error: wrong format at line $count \n"; }
 161                 # First Name, Last Name, Nickname, Name
 162                 write_person_h($field[0],$field[1],$field[4],$field[3]);
 163                 write_addrlist_h();
 164                 write_address("",$field[5],$field[$nboffields - 1]);
 165                 write_addrlist_f();
 166                 write_attrlist_h(); # the remaining values as attributes
 167                 foreach $a (2, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27) {
 168                         # add only filled fields (should be trimmed?)
 169                         if (defined($field[$a]) && $field[$a] ne "") {
 170                                 write_attribute($headerline[$a],$field[$a]);
 171                         }
 172                 }
 173                 write_attrlist_f();
 174                 write_person_f();
 175                 ++$count;
 176         }
 177         write_footer();
 178 }
 179
 180 # ok, was enough, do some more bit bashing now
 181 open(OUTL, $outl_file)
 182         or die "Error: can't open $outl_file for reading\n";
 183 # 1st line: file format checking (csv) or discarding (default)
 184 $_ = <OUTL>;
 185 chomp;
 186 if ($do_csv) {
 187         @headerline = split(/,/);
 188         # check before creating output file
 189         die "Error: unknown csv file format\n"
 190                 unless ($#headerline == $nboffields);
 191 }
 192 open(NEWB, '>', "$clawsconf/$new_book")
 193         or die "Error: can't open $clawsconf/$new_book for writing\n";
 194 if ($do_csv) { process_csv(); }
 195 else { process_text(); }
 196
 197 close NEWB;
 198 close OUTL;
 199
 200 # update index (more Paul's code :)
 201
 202 open(INDX, $indexname)
 203         or die "Error: can't open $indexname for reading\n";
 204 @index_file = <INDX>;
 205 close INDX;
 206
 207 foreach $index_line (@index_file) {
 208         if ($index_line =~ m/<\/book_list>/) {
 209                 $new_index .= "    <book name=\"Outlook Address Book\" file=\"$new_book\" />\n"."  </book_list>\n";                                                     } else {
 210                 $new_index .= "$index_line";
 211         }
 212 }
 213 open (INDX, '>', $indexname)
 214         or die "Error: can't open $indexname for writing\n";
 215 print INDX "$new_index";
 216 close INDX;
 217
 218 print "Done. $count address(es) converted successfully.\n";
 219