remove reference to freshmeat_search.pl
[claws.git] / 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";
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 writting\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 writting\n";
215 print INDX "$new_index";
216 close INDX;
217
218 print "Done. $count address(es) converted successfully.\n";
219