2008-05-16 [paul] 3.4.0cvs45
[claws.git] / tools / csv2addressbook.pl
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Getopt::Long qw(:config pass_through);
5 use Text::CSV_XS;
6
7 #  * This file is free software; you can redistribute it and/or modify it
8 #  * under the terms of the GNU General Public License as published by
9 #  * the Free Software Foundation; either version 3 of the License, or
10 #  * (at your option) any later version.
11 #  *
12 #  * This program is distributed in the hope that it will be useful, but
13 #  * WITHOUT ANY WARRANTY; without even the implied warranty of
14 #  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 #  * General Public License for more details.
16 #  *
17 #  * You should have received a copy of the GNU General Public License
18 #  * along with this program; if not, write to the Free Software
19 #  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
20 #  *
21 #  * Copyright 2007/2008 Paul Mangan <paul@claws-mail.org>
22 #  *
23
24 #
25 # Import CSV exported address books to Claws Mail
26 # Supported address books: 
27 #       Becky >= 2.41
28 #       Thunderbird >= 2.0.0.6
29 #       Kmail >= 1.9.7 / Kaddressbook >= 3.5.7          
30 #               ** kmail bug: can export badly formatted csv **
31 #       Gmail
32 #
33
34 # Becky: full export with titles
35 # thunderbird: export as 'comma separated'
36 # kmail/kaddressbook: Export CSV list
37 # gmail: export Outlook format
38
39 ###
40 my $quote_char = '"';
41 my $esc_char = '"';
42 my $sep_char = ',';
43 ###
44
45 my $script = "csv2addressbook.pl";
46 my $type = '';
47 my $csvfile = '';
48 my $bookname = '';
49 my $iNeedHelp = '';
50
51 my $known_types = qr/^(?:becky|thunderbird|kmail|gmail)$/;
52
53 GetOptions("type=s" => \$type,
54            "csv=s"  => \$csvfile,
55            "name=s" => \$bookname,
56            "help"   => \$iNeedHelp);
57
58 my @becky_fields = ('Name','E-mail Address', 'Nickname (Input shortcut)',
59                     'Web Page','Notes','Company','Department','Job Title',
60                     'Job Role','Last Name','First Name','Middle Name',
61                     'Birthday','Home Phone','Business Phone','Mobile Phone',
62                     'Fax','Street','City','State','Postal Code','Country',
63                     'Delivery Label');
64 my @tbird_fields = ('First Name','Last Name','Display Name','Nickname',
65                     'Primary Email','Secondary Email','Work Phone',
66                     'Home Phone','Fax Number','Pager Number','Mobile Number',
67                     'Home Address','Home Address 2','Home City','Home State',
68                     'Home ZipCode','Home Country','Work Address','Work Address 2',
69                     'Work City','Work State','Work ZipCode','Work Country',
70                     'Job Title','Department','Organization','Web Page 1',
71                     'Web Page 2','Birth Year','Birth Month','Birth Day',
72                     'Custom 1','Custom 2','Custom 3','Custom 4','Notes','junk');
73 my @kmail_fields = ('Formatted Name','Family Name','Given Name',
74                     'Additional Names','Honorific Prefixes','Honorific Suffixes',
75                     'Nick Name','Birthday','Home Address Street',
76                     'Home Address City','Home Address Region',
77                     'Home Address Post Code','Home Address Country',
78                     'Home Address Label','Business Address Street',
79                     'Business Address City','Business Address Region',
80                     'Business Address Post Code','Business Address Country',
81                     'Business Address Label','Home Phone','Business Phone',
82                     'Mobile Phone','Home Fax','Business Fax','Car Phone','ISDN',
83                     'Pager','Email Address','Mail Client','Title','Role',
84                     'Organisation','Department','Note','Homepage','Profession',
85                     'Assistant\'s Name','Manager\'s Name','Partner\'s Name',
86                     'Office','IM Address','Anniversary','Blog');
87 my @gmail_fields = ('Name','E-mail Address','Notes','E-mail 2 Address',
88                     'E-mail 3 Address','Mobile Phone','Pager','Company',
89                     'Job Title','Home Phone','Home Phone 2','Home Fax',
90                     'Home Address','Business Phone','Business Phone 2',
91                     'Business Fax','Business Address','Other Phone','Other Fax',
92                     'Other Address','junk');
93
94 if (grep m/claws-mail/ => `ps -U $ENV{USER}`) {
95         die("You must quit claws-mail before running this script\n");
96 }
97
98 if ($csvfile eq "" || $type eq "" || $type !~ m/$known_types/ || $iNeedHelp) {
99         if (!$iNeedHelp) {
100                 if ($csvfile eq "") {
101                         print "ERROR: Option csv is missing!\n";
102                 }
103                 if ($type eq "") {
104                         print "ERROR: Option type is missing!\n";
105                 }
106                 if ($type && $type !~ m/$known_types/) {
107                         print "ERROR: \"$type\" is an unknown type!\n";
108                 }
109         }
110         print qq~
111 Usage:
112         $script [OPTIONS]
113 Options:
114         --help                                  Show this screen
115         --type=becky|thunderbird|kmail|gmail    Type of exported address book
116         --csv=FILENAME                          Full path to CSV file
117         --name="My new address book"            Name of new Claws address book (optional)
118 ~;
119 exit;
120 }
121
122 open(INPUT, "<$csvfile") || die("Can't open the CSV file [$csvfile]\n");
123         my @csvlines = <INPUT>;
124 close INPUT;
125
126 my $config_dir = `claws-mail --config-dir` || die("ERROR:
127         You don't appear to have Claws Mail installed\n");
128 chomp $config_dir;
129
130 my $claws_version = `claws-mail --version`;
131 $claws_version =~ s/^Claws Mail version //;
132
133 my ($major, $minor) = split(/\./, $claws_version);
134
135 my $addr_dir;
136
137 if (($major == 3 && $minor >= 1) || $major > 3) {
138         $addr_dir = "$config_dir/addrbook";
139 } else {
140         $addr_dir = $config_dir;
141 }
142
143 my $addr_index = "$addr_dir/addrbook--index.xml";
144 my $csv = Text::CSV_XS->new({binary => 1,
145                              quote_char => $quote_char, 
146                              escape_char => $esc_char,
147                              sep_char => $sep_char});
148
149 my $csvtitles = shift(@csvlines);
150
151 $csv->parse($csvtitles);
152 my @csvfields = $csv->fields;
153
154 check_fields();
155
156 my $new_addrbook = $bookname || get_book_name();
157
158 my $xmlobject = write_xml();
159
160 chdir;
161
162 my @filelist = ();
163 opendir(ADDR_DIR, $addr_dir) || die("Can't open $addr_dir directory\n");
164         push(@filelist, (readdir(ADDR_DIR)));
165 closedir(ADDR_DIR);
166
167 my @files = ();
168 foreach my $file (@filelist) {
169         if ($file =~ m/^addrbook/ && $file =~ m/[0-9].xml$/) {
170                 push(@files, "$file");
171         }
172 }
173
174 my @sorted_files = sort {$a cmp $b} @files;
175 my $latest_file = pop(@sorted_files);
176 $latest_file =~ s/^addrbook-//;
177 $latest_file =~ s/.xml$//;
178 $latest_file++;
179 my $new_addrbk = "addrbook-"."$latest_file".".xml";
180
181 open (NEWADDR, ">$addr_dir/$new_addrbk");
182 print NEWADDR $xmlobject;
183 close NEWADDR;
184
185 open (ADDRIN, "<$addr_index") || die("can't open $addr_index for reading");
186         my @addrindex_file = <ADDRIN>;
187 close ADDRIN;
188
189 my $rw_addrindex;
190 foreach my $addrindex_line (@addrindex_file) {
191         if ($addrindex_line =~ m/<\/book_list>/) {
192                 $rw_addrindex .= "    <book name=\"$new_addrbook\" "
193                         ."file=\"$new_addrbk\" />\n  </book_list>\n";
194         } else {
195                 $rw_addrindex .= "$addrindex_line";
196         }
197 }
198
199 open (NEWADDRIN, ">$addr_index") || die("Can't open $addr_index for writing");
200 print NEWADDRIN "$rw_addrindex";
201 close NEWADDRIN;
202
203 print "Done. Address book imported successfully.\n";
204
205 exit;
206
207 sub get_book_name {
208         if ($type eq "becky") {
209                 return("Becky address book");
210         } elsif ($type eq "thunderbird") {
211                 return("Thunderbird address book");
212         } elsif ($type eq "kmail") {
213                 return("Kmail address book");
214         } elsif ($type eq "gmail") {
215                 return("gmail address book");
216         }
217 }
218
219 sub check_fields {
220         if ($type eq "becky") {
221                 if ($#csvfields != $#becky_fields) {
222                         die("ERROR:\n\tInvalid field count!\n"
223                            ."\tYou need to do a Full Export With Titles\n");
224                 }
225         } elsif ($type eq "thunderbird") {
226                 if ($#csvfields != $#tbird_fields) {
227                         die("ERROR:\n\tInvalid field count!\n"
228                            ."\tProblem with your exported CSV file\n");
229                 }
230         } elsif ($type eq "kmail") {
231                 if ($#csvfields != $#kmail_fields) {
232                         die("ERROR:\n\tInvalid field count!\n"
233                            ."\tProblem with your exported CSV file\n");
234                 }
235         } elsif ($type eq "gmail") {
236                 if ($#csvfields != $#gmail_fields) {
237                         die("ERROR:\n\tInvalid field count!\n"
238                            ."\tProblem with your exported CSV file\n");
239                 }
240         }
241 }
242
243 sub write_xml {
244         my @std_items = get_items();
245         my @input_fields = get_fields();
246
247         my $time = time;
248         my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
249                  ."<address-book name=\"$new_addrbook\" >\n  ";
250
251         my $prev_line;
252
253         foreach my $line (@csvlines) {
254                 $csv->parse($line);
255                 my @fields = $csv->fields;
256                 # check if an entry contains line breaks
257                 if ($#fields != $#input_fields) {
258                         if ($prev_line) {
259                                 my $concat_line = $prev_line.$line;
260                                 $csv->parse($concat_line);
261                                 @fields = $csv->fields;
262                                 if ($#fields != $#input_fields) {
263                                         $concat_line =~ s/\r\n$/ /;
264                                         $concat_line =~ s/\n$/ /;
265                                         $prev_line = $concat_line;
266                                         next;
267                                 }
268                         } else {
269                                 $line =~ s/\r\n$/ /;
270                                 $line =~ s/\n$/ /;
271                                 $prev_line = $line;
272                                 next;
273                         }
274                 }
275                 $prev_line = '';
276
277                 @fields = escape_fields(@fields);
278
279                 $xml .= "<person uid=\"$time\" "
280                        ."first-name=\"$fields[$std_items[0]]\" "
281                        ."last-name=\"$fields[$std_items[1]]\" "
282                        ."nick-name=\"$fields[$std_items[2]]\" "
283                        ."cn=\"$fields[$std_items[3]]\">\n    ";
284                 $time++;
285                 if ($type eq "thunderbird") {
286                         $xml .= "<address-list>\n      "
287                                ."<address uid=\"$time\" alias=\"\" "
288                                ."email=\"$fields[$std_items[4]]\" "
289                                ."remarks=\"\" />    \n";
290                         $time++;
291                         if ($fields[$std_items[5]]) {
292                                 $xml .="      <address uid=\"$time\" alias=\"\" "
293                                       ."email=\"$fields[$std_items[5]]\" "
294                                       ."remarks=\"\" />    \n";
295                         }
296                         $xml .= "    </address-list>    \n";
297                 } else {
298                         $xml .= "<address-list>\n      "
299                                ."<address uid=\"$time\" alias=\"\" "
300                                ."email=\"$fields[$std_items[4]]\" "
301                                ."remarks=\"$fields[$std_items[5]]\" />    \n"
302                                ."</address-list>    \n";
303                 }
304                 $xml .= "<attribute-list>\n";
305                 foreach my $item (@std_items) {
306                         delete($fields[$item]);
307                 }
308                 foreach my $field (0 .. $#fields) {
309                         if ($fields[$field]) { 
310                                 $time++;
311                                 $xml .= "      <attribute uid=\"$time\" "
312                                        ."name=\"$input_fields[$field]\">"
313                                        ."$fields[$field]</attribute>\n";
314                         }
315                 }
316                 $xml .= "    </attribute-list>\n  "
317                        ."</person>\n";
318                 $time++;
319         }
320
321         $xml .= "</address-book>\n";
322
323         return $xml;
324 }
325
326 sub get_items {
327         if ($type eq "becky") {
328                 return ('10','9','2','0','1','4');
329         } elsif ($type eq "thunderbird") {
330                 return ('0','1','3','2','4','5','38');
331         } elsif ($type eq "kmail") {
332                 return ('2','1','6','0','28','34');
333         } elsif ($type eq "gmail") {
334                 return('0','0','0','0','1','2');
335         }
336 }
337
338 sub get_fields {
339         if ($type eq "becky") {
340                 return(@becky_fields);
341         } elsif ($type eq "thunderbird") {
342                 return(@tbird_fields);
343         } elsif ($type eq "kmail") {
344                 return(@kmail_fields);
345         } elsif ($type eq "gmail") {
346                 return(@gmail_fields);
347         }
348 }
349
350 sub escape_fields {
351         my (@fields) = @_;
352
353         for (my $item = 0; $item <= $#fields; $item++) {
354                 $fields[$item] =~ s/^"//;
355                 $fields[$item] =~ s/"$//;
356                 $fields[$item] =~ s/"/&quot;/g;
357                 $fields[$item] =~ s/&/&amp;/g;
358                 $fields[$item] =~ s/'/&apos;/g;
359                 $fields[$item] =~ s/</&lt;/g;
360                 $fields[$item] =~ s/>/&gt;/g;
361         }
362         
363         return @fields;
364 }
365