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 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 #
  30
  31 # Becky: full export with titles
  32 # thunderbird: export as 'comma separated'
  33
  34 ###
  35 my $quote_char = '"';
  36 my $esc_char = '"';
  37 my $sep_char = ',';
  38 ###
  39
  40 my $script = "csv2addressbook.pl";
  41 my $type = '';
  42 my $csvfile = '';
  43 my $bookname = '';
  44 my $iNeedHelp = '';
  45
  46 my $known_types = qr/^(?:becky|thunderbird)$/;
  47
  48 GetOptions("type=s" => \$type,
  49            "csv=s"  => \$csvfile,
  50            "name=s" => \$bookname,
  51            "help"   => \$iNeedHelp);
  52
  53 my @becky_fields = ('Name','E-mail Address', 'Nickname (Input shortcut)',
  54                     'Web Page','Notes','Company','Department','Job Title',
  55                     'Job Role','Last Name','First Name','Middle Name',
  56                     'Birthday','Home Phone','Business Phone','Mobile Phone',
  57                     'Fax','Street','City','State','Postal Code','Country',
  58                     'Delivery Label');
  59 my @tbird_fields = ('First Name','Last Name','Display Name','Nickname',
  60                     'Primary Email','Secondary Email','Work Phone',
  61                     'Home Phone','Fax Number','Pager Number','Mobile Number',
  62                     'Home Address','Home Address 2','Home City','Home State',
  63                     'Home ZipCode','Home Country','Work Address','Work Address 2',
  64                     'Work City','Work State','Work ZipCode','Work Country',
  65                     'Job Title','Department','Organization','Web Page 1',
  66                     'Web Page 2','Birth Year','Birth Month','Birth Day',
  67                     'Custom 1','Custom 2','Custom 3','Custom 4','Notes','junk');
  68
  69 if (grep m/claws-mail/ => `ps -U $ENV{USER}`) {
  70         die("You must quit claws-mail before running this script\n");
  71 }
  72
  73 if ($csvfile eq "" || $type eq "" || $type !~ m/$known_types/ || $iNeedHelp) {
  74         if (!$iNeedHelp) {
  75                 if ($csvfile eq "") {
  76                         print "ERROR: Option csv is missing!\n";
  77                 }
  78                 if ($type eq "") {
  79                         print "ERROR: Option type is missing!\n";
  80                 }
  81                 if ($type && $type !~ m/$known_types/) {
  82                         print "ERROR: \"$type\" is an unknown type!\n";
  83                 }
  84         }
  85         print qq~
  86 Usage:
  87         $script [OPTIONS]
  88 Options:
  89         --help                          Show this screen
  90         --type=becky|thunderbird        Type of exported address book
  91         --csv=FILENAME                  Full path to CSV file
  92         --name="My new address book"    Name of new Claws address book (optional)
  93 ~;
  94 exit;
  95 }
  96
  97 open(INPUT, "<$csvfile") || die("Can't open the CSV file [$csvfile]\n");
  98         my @csvlines = <INPUT>;
  99 close INPUT;
 100
 101 my $config_dir = `claws-mail --config-dir` || die("ERROR:
 102         You don't appear to have Claws Mail installed\n");
 103 chomp $config_dir;
 104
 105 my $claws_version = `claws-mail --version`;
 106 $claws_version =~ s/^Claws Mail version //;
 107
 108 my ($major, $minor) = split(/\./, $claws_version);
 109
 110 my $addr_dir;
 111
 112 if (($major == 3 && $minor >= 1) || $major > 3) {
 113         $addr_dir = "$config_dir/addrbook";
 114 } else {
 115         $addr_dir = $config_dir;
 116 }
 117
 118 my $addr_index = "$addr_dir/addrbook--index.xml";
 119 my $csv = Text::CSV_XS->new({binary => 1,
 120                              quote_char => $quote_char,
 121                              escape_char => $esc_char,
 122                              sep_char => $sep_char});
 123
 124 my $csvtitles = shift(@csvlines);
 125
 126 $csv->parse($csvtitles);
 127 my @csvfields = $csv->fields;
 128
 129 check_fields();
 130
 131 my $new_addrbook = $bookname || get_book_name();
 132
 133 my $xmlobject = write_xml();
 134
 135 chdir;
 136
 137 my @filelist = ();
 138 opendir(ADDR_DIR, $addr_dir) || die("Can't open $addr_dir directory\n");
 139         push(@filelist, (readdir(ADDR_DIR)));
 140 closedir(ADDR_DIR);
 141
 142 my @files = ();
 143 foreach my $file (@filelist) {
 144         if ($file =~ m/^addrbook/ && $file =~ m/[0-9].xml$/) {
 145                 push(@files, "$file");
 146         }
 147 }
 148
 149 my @sorted_files = sort {$a cmp $b} @files;
 150 my $latest_file = pop(@sorted_files);
 151 $latest_file =~ s/^addrbook-//;
 152 $latest_file =~ s/.xml$//;
 153 $latest_file++;
 154 my $new_addrbk = "addrbook-"."$latest_file".".xml";
 155
 156 open (NEWADDR, ">$addr_dir/$new_addrbk");
 157 print NEWADDR $xmlobject;
 158 close NEWADDR;
 159
 160 open (ADDRIN, "<$addr_index") || die("can't open $addr_index for reading");
 161         my @addrindex_file = <ADDRIN>;
 162 close ADDRIN;
 163
 164 my $rw_addrindex;
 165 foreach my $addrindex_line (@addrindex_file) {
 166         if ($addrindex_line =~ m/<\/book_list>/) {
 167                 $rw_addrindex .= "    <book name=\"$new_addrbook\" "
 168                         ."file=\"$new_addrbk\" />\n  </book_list>\n";
 169         } else {
 170                 $rw_addrindex .= "$addrindex_line";
 171         }
 172 }
 173
 174 open (NEWADDRIN, ">$addr_index") || die("Can't open $addr_index for writing");
 175 print NEWADDRIN "$rw_addrindex";
 176 close NEWADDRIN;
 177
 178 print "Done. Address book imported successfully.\n";
 179
 180 exit;
 181
 182 sub get_book_name {
 183         if ($type eq "becky") {
 184                 return("Becky address book");
 185         } elsif ($type eq "thunderbird") {
 186                 return("Thunderbird address book");
 187         }
 188 }
 189
 190 sub check_fields {
 191         if ($type eq "becky") {
 192                 if ($#csvfields != $#becky_fields) {
 193                         die("ERROR:\n\tNot enough fields!\n"
 194                            ."\tYou need to do a Full Export With Titles\n");
 195                 }
 196         } elsif ($type eq "thunderbird") {
 197                 if ($#csvfields != $#tbird_fields) {
 198                         die("ERROR:\n\tNot enough fields!\n"
 199                            ."\tProblem with your exported CSV file\n");
 200                 }
 201         }
 202 }
 203
 204 sub write_xml {
 205         my @std_items = get_items();
 206         my @input_fields = get_fields();
 207
 208         my $time = time;
 209         my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
 210                  ."<address-book name=\"$new_addrbook\" >\n  ";
 211
 212         my $prev_line;
 213
 214         foreach my $line (@csvlines) {
 215                 $csv->parse($line);
 216                 my @fields = $csv->fields;
 217                 # check if an entry contains line breaks
 218                 if ($#fields != $#input_fields) {
 219                         if ($prev_line) {
 220                                 my $concat_line = $prev_line.$line;
 221                                 $csv->parse($concat_line);
 222                                 @fields = $csv->fields;
 223                                 if ($#fields != $#input_fields) {
 224                                         $concat_line =~ s/\r\n$/ /;
 225                                         $concat_line =~ s/\n$/ /;
 226                                         $prev_line = $concat_line;
 227                                         next;
 228                                 }
 229                         } else {
 230                                 $line =~ s/\r\n$/ /;
 231                                 $line =~ s/\n$/ /;
 232                                 $prev_line = $line;
 233                                 next;
 234                         }
 235                 }
 236                 $prev_line = '';
 237
 238                 @fields = escape_fields(@fields);
 239
 240                 $xml .= "<person uid=\"$time\" "
 241                        ."first-name=\"$fields[$std_items[0]]\" "
 242                        ."last-name=\"$fields[$std_items[1]]\" "
 243                        ."nick-name=\"$fields[$std_items[2]]\" "
 244                        ."cn=\"$fields[$std_items[3]]\">\n    ";
 245                 $time++;
 246                 if ($type eq "thunderbird") {
 247                         $xml .= "<address-list>\n      "
 248                                ."<address uid=\"$time\" alias=\"\" "
 249                                ."email=\"$fields[$std_items[4]]\" "
 250                                ."remarks=\"\" />    \n";
 251                         $time++;
 252                         if ($fields[$std_items[5]]) {
 253                                 $xml .="      <address uid=\"$time\" alias=\"\" "
 254                                       ."email=\"$fields[$std_items[5]]\" "
 255                                       ."remarks=\"\" />    \n";
 256                         }
 257                         $xml .= "    </address-list>    \n";
 258                 } else {
 259                         $xml .= "<address-list>\n      "
 260                                ."<address uid=\"$time\" alias=\"\" "
 261                                ."email=\"$fields[$std_items[4]]\" "
 262                                ."remarks=\"$fields[$std_items[5]]\" />    \n"
 263                                ."</address-list>    \n";
 264                 }
 265                 $xml .= "<attribute-list>\n";
 266                 foreach my $item (@std_items) {
 267                         delete($fields[$item]);
 268                 }
 269                 foreach my $field (0 .. $#fields) {
 270                         if ($fields[$field]) {
 271                                 $time++;
 272                                 $xml .= "      <attribute uid=\"$time\" "
 273                                        ."name=\"$input_fields[$field]\">"
 274                                        ."$fields[$field]</attribute>\n";
 275                         }
 276                 }
 277                 $xml .= "    </attribute-list>\n  "
 278                        ."</person>\n";
 279                 $time++;
 280         }
 281
 282         $xml .= "</address-book>\n";
 283
 284         return $xml;
 285 }
 286
 287 sub get_items {
 288         if ($type eq "becky") {
 289                 return ('10','9','2','0','1','4');
 290         } elsif ($type eq "thunderbird") {
 291                 return ('0','1','3','2','4','5','38');
 292         }
 293 }
 294
 295 sub get_fields {
 296         if ($type eq "becky") {
 297                 return(@becky_fields);
 298         } elsif ($type eq "thunderbird") {
 299                 return(@tbird_fields);
 300         }
 301 }
 302
 303 sub escape_fields {
 304         my (@fields) = @_;
 305
 306         for (my $item = 0; $item <= $#fields; $item++) {
 307                 $fields[$item] =~ s/^"//;
 308                 $fields[$item] =~ s/"$//;
 309                 $fields[$item] =~ s/"/&quot;/g;
 310                 $fields[$item] =~ s/&/&amp;/g;
 311                 $fields[$item] =~ s/'/&apos;/g;
 312                 $fields[$item] =~ s/</&lt;/g;
 313                 $fields[$item] =~ s/>/&gt;/g;
 314         }
 315
 316         return @fields;
 317 }
 318