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;
33die "Error: required filename missing\n" unless (defined($ARGV[0]));
34$_=$ARGV[0];
35if (/--csv/) {
36	die "Error: required filename missing\n" unless (defined($ARGV[1]));
37	$do_csv = 1;
38	$outl_file = $ARGV[1];
39}
40else {
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
50chdir;
51opendir(CLAWS, $clawsconf) || die("Error: can't open $clawsconf directory\n");
52	push(@cached,(readdir(CLAWS)));
53closedir(CLAWS);
54
55foreach $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
70sub 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
75sub write_footer {
76	print NEWB "</address-book>\n";
77}
78
79sub 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
90sub write_person_f {
91	print NEWB "  </person>\n";
92}
93
94sub write_addrlist_h {
95	print NEWB "    <address-list>\n";
96}
97
98sub write_addrlist_f {
99	print NEWB "    </address-list>\n";
100}
101
102sub 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
114sub write_attrlist_h {
115	print NEWB "    <attribute-list>\n";
116}
117
118sub write_attrlist_f {
119	print NEWB "    </attribute-list>\n";
120}
121
122sub 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
129sub 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
148sub 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
181open(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>;
185chomp;
186if ($do_csv) {
187	@headerline = split(/,/);
188	# check before creating output file
189	die "Error: unknown csv file format\n"
190		unless ($#headerline == $nboffields);
191}
192open(NEWB, '>', "$clawsconf/$new_book")
193	or die "Error: can't open $clawsconf/$new_book for writing\n";
194if ($do_csv) { process_csv(); }
195else { process_text(); }
196
197close NEWB;
198close OUTL;
199
200# update index (more Paul's code :)
201
202open(INDX, $indexname)
203	or die "Error: can't open $indexname for reading\n";
204@index_file = <INDX>;
205close INDX;
206
207foreach $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}
213open (INDX, '>', $indexname)
214	or die "Error: can't open $indexname for writing\n";
215print INDX "$new_index";
216close INDX;
217
218print "Done. $count address(es) converted successfully.\n";
219
220