237 lines
7.0 KiB
Perl
Executable File
237 lines
7.0 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# cvs2vcard - Script to convert Outlook CSV files into VCard files
|
|
# suitable to be imported into Evolution.
|
|
#
|
|
# Copyright (C) 2001 Ximian, Inc.
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of version 2 of the GNU General Public
|
|
# License as published by the Free Software Foundation.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public
|
|
# License along with this program; if not, write to the
|
|
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
# Boston, MA 02111-1307, USA.
|
|
#
|
|
# Author: Michael MacDonald <mjmac@ximian.com>
|
|
#
|
|
|
|
use strict;
|
|
use diagnostics;
|
|
use Text::ParseWords;
|
|
|
|
sub usage
|
|
{
|
|
print STDERR << "--EndOfUsage";
|
|
|
|
Takes a CSV-formatted list of contacts from Outlook and attempts to
|
|
convert it into a list of VCards suitable for import into Evolution.
|
|
|
|
Usage: $0 [infile outfile]
|
|
|
|
--EndOfUsage
|
|
|
|
exit;
|
|
}
|
|
|
|
sub is_recognized_format
|
|
{
|
|
my $line = shift;
|
|
|
|
# Making some assumptions here... Prolly OK.
|
|
return $line =~ /(First Name|Middle Name|Last Name)/;
|
|
}
|
|
|
|
sub map_columns
|
|
{
|
|
my $line = shift;
|
|
|
|
my @names = parse_line(',', 0, $line);
|
|
|
|
my $ctr = 0;
|
|
my %fieldmap = map { $_ => $ctr++ } @names;
|
|
|
|
return %fieldmap;
|
|
}
|
|
|
|
sub build_vcard_attr_from_def
|
|
{
|
|
my ($def, $fields, $map) = @_;
|
|
|
|
# Valid chars for lookup (from Outlook CSV) are
|
|
# A-Za-z0-9_-'/
|
|
# Valid chars for formatting of attr are
|
|
# \s,|
|
|
my @lookup = map { s/=0A$//; s/[^\w\s\-'\/]//; $_; } split /[\s,]*\|[\s,]*/, $def;
|
|
|
|
foreach my $el (@lookup) {
|
|
unless (defined($map->{ $el })) {
|
|
print STDERR "$el is undefined\n";
|
|
next;
|
|
}
|
|
if (defined($fields->[$map->{ $el }])) {
|
|
unless ($fields->[$map->{ $el }] =~ /(^$|0\/0\/00)/) {
|
|
$def =~ s/$el/$fields->[$map->{ $el }]/;
|
|
} else {
|
|
$def =~ s/((?<=\|)\s*)?$el(\s*?(?=\|))?(=0A)?,?//;
|
|
}
|
|
} else {
|
|
$def =~ s/((?<=\|)\s*)?$el(\s*?(?=\|))?(=0A)?,?//;
|
|
}
|
|
}
|
|
# Get rid of field delimiters
|
|
$def =~ s/\|//g;
|
|
# Snip off any trailing semicolons or whitespace
|
|
$def =~ s/[\s;]*$//;
|
|
|
|
return $def;
|
|
}
|
|
|
|
sub build_vcard_from_line {
|
|
my ($line, %map) = @_;
|
|
my %vcard;
|
|
|
|
my @fields = parse_line(',', 0, $line);
|
|
|
|
my %vcard_def = ( FN => 'Title |First Name |Middle Name |Last Name |Suffix',
|
|
N => 'Last Name| Suffix|;First Name|;Middle Name|;Title',
|
|
'ADR;WORK' => 'PO Box|;Business Street 2|;Business Street|;Business City|;Business State|;Business Postal Code|;Business Country',
|
|
'LABEL;QUOTED-PRINTABLE;WORK' => 'PO Box |Business Street=0A|Business Street 2=0A|Business City,| Business State| Business Postal Code=0A|Business Country',
|
|
'TEL;WORK;VOICE' => 'Business Phone',
|
|
'TEL;WORK;VOICE2' => 'Business Phone 2',
|
|
'TEL;WORK;FAX' => 'Business Fax',
|
|
'TEL;WORK;COMPANY' => 'Company Main Phone',
|
|
'ADR;HOME' => ';Home Street 2|;Home Street|;Home City|;Home State|;Home Postal Code|;Home Country',
|
|
'LABEL;QUOTED-PRINTABLE;HOME' => 'Home Street=0A|Home Street 2=0A|Home City,| Home State| Home Postal Code=0A|Home Country',
|
|
'TEL;HOME;VOICE' => 'Home Phone',
|
|
'TEL;HOME;VOICE2' => 'Home Phone 2',
|
|
'TEL;HOME;FAX' => 'Home Fax',
|
|
'ADR;POSTAL' => ';Other Street 2|;Other Street|;Other City|;Other State|;Other Postal Code|;Other Country',
|
|
'LABEL;QUOTED-PRINTABLE;POSTAL' => 'Other Street=0A|Other Street 2=0A|Other City,| Other State| Other Postal Code=0A|Other Country',
|
|
'TEL;VOICE' => 'Other Phone',
|
|
'TEL;FAX' => 'Other Fax',
|
|
'TEL;CELL' => 'Mobile Phone',
|
|
'TEL;CAR' => 'Car Phone',
|
|
'TEL;PAGER' => 'Pager',
|
|
'TEL;PREF' => 'Primary Phone',
|
|
'TEL;ISDN' => 'ISDN',
|
|
'TEL;X-EVOLUTION-CALLBACK' => 'Callback',
|
|
'TEL;X-EVOLUTION-TTYTDD' => 'TTY/TDD Phone',
|
|
'TEL;X-EVOLUTION-TELEX' => 'Telex',
|
|
'TEL;X-EVOLUTION-RADIO' => 'Radio Phone',
|
|
'EMAIL;INTERNET' => 'E-mail Address',
|
|
'EMAIL;INTERNET2' => 'E-mail 2 Address',
|
|
'EMAIL;INTERNET3' => 'E-mail 3 Address',
|
|
ORG => 'Company|;Department',
|
|
TITLE => 'Job Title',
|
|
ROLE => 'Profession',
|
|
'X-EVOLUTION-ASSISTANT' => "Assistant's Name",
|
|
'TEL;X-EVOLUTION-ASSISTANT' => "Assistant's Phone",
|
|
'X-EVOLUTION-SPOUSE' => 'Spouse',
|
|
'X-EVOLUTION-ANNIVERSARY' => 'Anniversary',
|
|
'X-EVOLUTION-MANAGER' => "Manager's Name",
|
|
'X-EVOLUTION-OFFICE' => 'Office Location',
|
|
BDAY => 'Birthday',
|
|
NOTE => 'Notes',
|
|
FBURL => 'Internet Free Busy',
|
|
URL => 'Web Page',
|
|
);
|
|
|
|
foreach my $key (keys(%vcard_def)) {
|
|
my $attr = build_vcard_attr_from_def($vcard_def{ $key }, \@fields, \%map);
|
|
if (defined($attr)) {
|
|
$vcard{ $key } = $attr unless ($attr =~ /^$/);
|
|
}
|
|
}
|
|
|
|
return %vcard;
|
|
}
|
|
|
|
sub print_vcard_to_fh
|
|
{
|
|
my ($fh, %vcard) = @_;
|
|
|
|
print $fh "BEGIN:VCARD\n";
|
|
foreach my $key (keys(%vcard)) {
|
|
# Dirty hack because Evolution's vcard stores multiple email addrs
|
|
# with same sttribute, hence key collision. Bleah.
|
|
# Ugh! Same deal for multiple phones... (eg. bus. phone)
|
|
#
|
|
# And finally, while we're special-casing... Outlook exports dates
|
|
# differently, so munge 'em if we find 'em.
|
|
if ($key =~ /EMAIL;INTERNET/o) {
|
|
(my $temp = $key) =~ s/\d$//;
|
|
print $fh "$temp:$vcard{ $key }\n";
|
|
} elsif ($key =~ /TEL;(HOME|WORK)/o) {
|
|
(my $temp = $key) =~ s/\d$//;
|
|
print $fh "$temp:$vcard{ $key }\n";
|
|
} elsif ($key =~ /(BDAY|X\-EVOLUTION\-ANNIVERSARY)/o) {
|
|
my $temp = $vcard{ $key };
|
|
if ($temp =~ /(\d\d)\/(\d\d)\/(\d\d)/) {
|
|
# Y2k !! MS Didn't learn anything.
|
|
# Hope no one was born before 1915
|
|
if ((1900 + $3) < 1915) {
|
|
print $fh "$key:20$3-$1-$2\n";
|
|
} else {
|
|
print $fh "$key:19$3-$1-$2\n";
|
|
}
|
|
} else {
|
|
# Something's funky... Just delete the attribute
|
|
print STDERR "Couldn't figure out what to do with $key:$vcard{ $key }\n";
|
|
delete($vcard{ $key });
|
|
}
|
|
} else {
|
|
print $fh "$key:$vcard{ $key }\n";
|
|
}
|
|
}
|
|
print $fh "END:VCARD\n\n";
|
|
}
|
|
|
|
my $in = $ARGV[0];
|
|
my $out = $ARGV[1];
|
|
|
|
usage() unless(defined($in) && defined($out));
|
|
|
|
open (IN, $in)
|
|
or die "Can't open($in): $!\n";
|
|
|
|
open (OUT, ">$out")
|
|
or die "Can't open($out): $!\n";
|
|
|
|
my $linectr = 0;
|
|
my %map;
|
|
|
|
while (my $line = <IN>) {
|
|
$line =~ s/\r//g;
|
|
$line =~ s/\n$//;
|
|
if ($linectr == 0) {
|
|
$linectr++;
|
|
usage() unless is_recognized_format($line);
|
|
%map = map_columns($line);
|
|
#if ($line =~ /\r\n$/) {
|
|
# print STDERR "Apparenlty found DOS-style EOL indicators...\n";
|
|
$/ = "\r\n";
|
|
#}
|
|
} else {
|
|
$linectr++;
|
|
while ($line =~ /^(("([^"]|\n|"")*")?,)*"([^"]|\n|"")*$/) {
|
|
my $temp = $line;
|
|
$line = <IN>;
|
|
$line =~ s/\r//g;
|
|
$line =~ s/\n$//;
|
|
$line = "$temp $line";
|
|
}
|
|
my %vcard = build_vcard_from_line($line, %map);
|
|
print_vcard_to_fh(\*OUT, %vcard);
|
|
}
|
|
}
|
|
|
|
close(IN);
|
|
close(OUT);
|