outlook2claws-mail.pl 6.0 KB

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