#!/usr/bin/perl -w

# vcard2kiax.pl
# Purpose: to convert a vcard address book (such as used by kabc) into the format used by Kiax
# Copyright: David Anderson <vcard2kiax@dw-perspective.org.uk>
# License: GPL v2 or later, or Perl Artistic License, at your discretion

# Usage: vcard2kiax.pl --help

my $version="1 (2005-Apr-22)";

use strict;
use Getopt::Long;
use Pod::Usage;

my $kiaxrc = "$ENV{'HOME'}/.qt/kiaxrc";
my $try_account = "";
my $verbose = 0;
my $skip_backup = 0;
my $output_file;
my $myinternationalcode = "44";
my $myinternationalprefix = "00";
my $strip_prefix = "0";
my $leave_prefixes_alone = 0;

&options;

my $output="";

unless ( -r $kiaxrc ) { die "Cannot find kiaxrc file '$kiaxrc'" } elsif ($verbose) { warn "Found kiaxrc: $kiaxrc" }

unless ($skip_backup) {system("cp","-f",$kiaxrc,$kiaxrc.".bak"); }

my %accounts; my %numbers; my $done_accounts=0; my $in_accounts=0; my $default_account=-1; my $in_contacts=0; my $max_contactid = 0;
my $kiaxrc_aftercontacts="";
open FH,$kiaxrc;
while ( my $li=<FH> ) {
chomp $li;
if ($li =~ /^\[(\S+)\]$/) {
if ($1 eq "accounts") {$in_accounts=1; $in_contacts=0;}
elsif ($1 eq "contacts") {$in_accounts=0; $in_contacts=1;}
else {$in_accounts=0; $in_contacts+=2;}
}
elsif ( $in_accounts == 1 ) {
if ($li =~ /^(\d+)\/(\S+)=(.+)$/) { if ($2 eq "alias") {$accounts{$3}=$1; if ($verbose) { warn "Account found: '$3' (id $1)" } } }
elsif ($li =~ /^defaultAccountID=(\d+)$/i) { $default_account=$1 }
}
elsif ( $in_contacts == 1 ) {
if ($li =~ /^(\d+)\/number=(.+)$/) { my $id=$1; $numbers{$2} = $id; if ($id > $max_contactid) {$max_contactid=$id;} }
}
if ($in_contacts==0 || ($in_contacts==1 && $li)) { &output($li."\n"); } elsif ($in_contacts>=2) {$kiaxrc_aftercontacts.=$li."\n"};
}
close FH;

my $use_account = $default_account;
my $contactid = $max_contactid + 1;


if ($try_account) {
if (defined($accounts{$try_account})) { $use_account=$accounts{$try_account}} else {die "Fatal Error: could not detect account '$try_account' - leave out the account option to use the default.";}
}
else {
unless ($default_account != -1) {die "Fatal Error: could not detect default account"}
}

my $name=""; my $num=""; my $oname="";

while (my $li=<>) {
$li =~ s/(\r|\n)//g;
if ($li =~ /^(\S+):(.+)$/) {
my ($key,$value)=($1,$2);
if ($key eq "END" && $value eq "VCARD") {
if ($name !~ /^\s/ && $num && !defined($numbers{$num})) {
if ($verbose) { warn "Adding contact '$name' with number '$num' with id $contactid to account $use_account" }
&output("$contactid/accountID=$use_account\n$contactid/name=$name\n$contactid/number=$num\n");}
$name=""; $num=""; $contactid++; $oname="";
}
elsif ($key eq "FN")  {$name=$value.$name; $oname=$value;}
elsif ($key eq "N") {unless($name) {
foreach my $component (split(/;/,$value)) {if ($component) {if ($name) {$name=$component." ".$name} else {$name=$component}}}; 
}}
elsif (substr($key,0,3) eq "TEL")  {

if ($num) { if ($name !~ /^\s/ && $num && !defined($numbers{$num})) {
if ($verbose) { warn "Adding contact '$name' with number '$num' with id $contactid to account $use_account" }
&output("$contactid/accountID=$use_account\n$contactid/name=$name\n$contactid/number=$num\n");
}
$contactid++; $num=""; $name = $oname;}

$key=substr($key,3);
if ($key =~ /TYPE=(\w+)/i ) {
foreach my $bit (split(/;/,$key)) {if ($bit =~ /^TYPE=(\w+)/) {my $add=$1; if (uc($add) ne "PREF" && $name !~ /\($add\)/) {$name.=" ($1)";}}}
};
$value =~ s/(\s)//g;
unless ($leave_prefixes_alone) {
unless ($value =~ /^$myinternationalprefix/) { $value =~ s/^$strip_prefix/$myinternationalprefix$myinternationalcode/ };
}
$num=$value;
}
}
}

&output("\n".$kiaxrc_aftercontacts);

if ($output_file) {
open WH,">".$output_file || die $!;
print WH $output;
close WH;
}

exit;

sub output () {
my $op=$_[0];
if ($output_file) {$output.=$op;} else {print $op}
}

sub options () {
my $help = 0;
my $tell_version = 0;
my $man = 0;

if ( @ARGV > 0 ) {
GetOptions('kiaxrc=s' => \$kiaxrc,
   'account=s' => \$try_account,
   'help|?|usage' => \$help,
   'verbose' => \$verbose,
   'man' => \$man,
   'leave-prefixes-alone' => \$leave_prefixes_alone,
   'international-prefix=s' => \$myinternationalprefix,
   'international-code=s' => \$myinternationalcode,
   'strip-prefix=s' => \$strip_prefix,
   'output-file=s' => \$output_file,
   'no-backup' => \$skip_backup,
   'version' => \$tell_version )
or pod2usage({ -exitval => 1, -verbose => 1 });
}
if ( $help ) { pod2usage( { -exitval => 0,  -verbose => 1 } ); }
if ( $man ) { pod2usage( { -exitval => 0,  -verbose => 2 } ); }
if ( $tell_version ) { print $version."\n"; exit 0}
}


=head1 NAME

vcard2kiax.pl - Convert VCARD address books/cards for usage in Kiax

=head1 SYNOPSIS

vcard2kiax.pl [options] [file (defaults to STDIN)]

=head1 OPTIONS

Options:

   --account			indicate name of Kiax account to import into (defaults to default Kiax account)
   --kiaxrc			location of kiaxrc configuration file (defaults to ~/.qt/kiaxrc)
   --no-backup			don't make a backup of kiaxrc (same location with .bak suffixed); otherwise, do
   --output-file		print output to this file (defaults to STDOUT)
   --leave-prefixes-alone	don't make any changes to telephone numbers when importing them (otherwise, do)
   --international-prefix	indicates prefix to use for international dialling (defaults to 00)
   				If this is missing from any number, then the prefix specified by --strip-prefix
				is removed, and then this together with the international code is added
				(all of this happens only if --leave-prefixes-alone is not specified)
   --international-code		defaults to 44 (UK) - see description of --international-prefix for behaviour
   --strip-prefix		defaults to 0 - see description of --international-prefix
   --help			this brief help message
   --man	.		print a full man page (recommended to read this)
   --version			print version information
   --verbose			print limited commentary to STDERR - useful for resolving errors
   
=head1 DESCRIPTION

This program reads the VCARD address book/card supplied on STDIN (or command line) and combines it with a Kiax configuration file, sending the result to STDOUT (or to the indicated file). Any phone numbers found in the VCARD which are _not_ already in Kiax's contacts list are imported. If it does not work as you expect it to, then try using the --verbose option to see what it is trying to do.

Warning: do not try to read from and redirect STDOUT to the same file, or you will destroy it. If you wish to overwrite a file, instead use the --output-file switch and overwriting will only happen once all reading is finished.

Example usage of simplest case (merge all contacts into default configuration file):

vcard2kiax.pl --output-file ~/.qt/kiaxrc < /path/to/vcard.vcf

Example usage for merging KDE's address book:

vcard2kiax.pl --output-file ~/.qt/kiaxrc < ~/.kde/share/apps/kabc/std.vcf

Quick way to destroy your kiax configuration file:

vcard2kiax.pl > ~/.qt/kiaxrc < /path/to/vcard.vcf

Example usage if you do not wish to add international prefixes to your numbers:

vcard2kiax.pl --output-file ~/.qt/kiaxrc --leave-prefixes-alone < /path/to/vcard.vcf

Example usage if you dial 58 for an international number, and your own country code is 25, and your have to remove 5 from the number when dialling internationally (if not specified, the defaults of 00, 44, 0 for the UK will be used - that is, an example UK number dialled from the UK would be 01234 567890, but to dial international style would be 00 44 1234 567890):

vcard2kiax.pl --output-file ~/.qt/kiaxrc --international-prefix 58 --international-code 25 --strip-prefix 5 < /path/to/vcard.vcf

=head1 AUTHOR

David Anderson <vcard2kiax@dw-perspective.org.uk>

=head1 COPYRIGHT

This programs is Copyright 2005, David Anderson.

This program is free software; you can redistribute it and/or modify
it under the terms of the Perl Artistic License or the GNU General
Public License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

=cut