BME központi;+3614631111
####
#!perl
use strict; use warnings;
use re "/u";
open my$I, "<:encoding(utf-8)", $ARGV[0] or die qq(error open: $!);
open my$O, ">", $ARGV[1] or die qq(open out: $!);
binmode STDERR, ":encoding(cp852)" or die;
my$counter = 0;
while(my$l = <$I>) {
chomp $l;
$l =~ tr/[\x00-\x1f\x7f-\x90]// and die qq(error: control characters);
my($n, @r) = split /;/, $l;
4 <= length $n || "\xc9n" eq $n || "P\x{f3}t" eq $n or die qq(error: name too short: $n);
$n =~ /\A[-+.,0-9 A-Za-z\x{c1}\x{c9}\x{cd}\x{d3}\x{d6}\x{0150}\x{da}\x{dc}\x{0170}\x{e1}\x{e9}\x{ed}\x{f3}\x{f6}\x{151}\x{fa}\x{fc}\x{171}]{2,}\z/ or
die qq(error: strange characters $n);
$n =~ /\A\p{Lu}|\A\+\p{Ll}/ or die qq(error: name doesn't start with letter: $n);
$n =~ /(?:\pL){4}|(?:\pL){3}.*(?:\pL){3}z/ or die qq(error: name not enough letters: $n); # the actual code has more branches here to whitelist some short names in my phonebook
$n =~ / \z/ and die qq(trailing space: $n);
$n =~ /[0-9\pL]\z/ or die qq(trailing punct: $n);
$n =~ y/[0-9]// <= 4 or die qq(error: name has too many digits: $n);
my@t;
F: for my$r (@r) {
$r =~ /\A(X-NOKIA-PND-GROUP|NOTE)=/ and next;
$r =~ /=/ and die qq(strange field: $r);
$r =~ /\A[+p0-9*#]+\z/ or die qq(not phone number: $r);
if ($r =~ /\A\+36/) {
$r =~ /\A\+36(?:1[0-9]{7}|[237][0-9]+|([2-9][1-9]|[8]0)[0-9]{6})(p[0-9*#]+)?\z/ or warn qq(wrong length or landline hu: $r); # this one is actually incorrect since there are now new 7-digit mobile phone numbers starting with +3631 and +3650, but I didn't have any in my phonebook yet
} elsif ($r =~ /\A\+[1-9][0-9]{8,}+\z/) {
0 and warn qq(abroad: $r $n); # I had these and the following warnings disabled after I verified that the few numbers they matched were valid
} elsif ($r =~ /\A1[0-9]{3,4}\z/) {
0 and warn qq(shortcut number: $r $n);
} elsif ($r =~ /\Ap.*\z/) {
0 and warn qq(comment: $r $n);
} elsif ($r =~ /\A[*#][0-9*#]{3,12}\z/ && $n =~ /\A\+/) {
0 and warn qq(code: $r $n)
} else {
die qq(invalid number: $r $n);
}
push @t, $r;
}
@t or die qq(no number in line: $l);
@t<=2 or die qq(more than two numbers in line: $l);
for my$ii (keys @t) {
my$t = $r[$ii];
my$nn = $n . "'" x $ii;
length($nn) < 30 or die qq(name too long);
print $O qq(BEGIN:VCARD\nVERSION:2.1\nN;ENCODING=QUOTED-PRINTABLE;CHARSET=UTF-8:;=\n) or die;
my$no = Encode::encode_utf8($nn);
$no =~ s{([^a-zA-Z0-9])}{sprintf "=%02X", ord$1}ge;
print $O qq($no;;;\nTEL;VOICE;CELL:$t\nEND:VCARD\n\n) or die;
}
}
eof($I) or die qq(error read);
close $O or die qq(error read);
warn qq(tovcard all ok;\n);
__END__
##
##
BEGIN:VCARD
VERSION:2.1
N;ENCODING=QUOTED-PRINTABLE;CHARSET=UTF-8:;=
BME=20k=C3=B6zponti;;;
TEL;VOICE;CELL:+3614631111
END:VCARD
##
##
perl -we 'while (<>) { if (/^\r\n\z/) {} elsif ($c) { $c=0; /^(.*);;;\r\n\z/ or die "nc $_"; $f=";CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:"; print "N$f;$;$1;;;\r\nFN$f$1\r\n"; } elsif (/^N;/) { /^N;ENCODING=QUOTED-PRINTABLE;CHARSET=UTF-8:;=\r\n\z/ or die; $c=1; } elsif (/^TEL;/) { /^TEL;[A-Z]+;(CELL:[+0-9#*p]+)\r\n/ or die qq(tel $_); print "TEL;CELL:$1\r\n"; } elsif (/^(BEGIN:|VERSION:|END:)/) { print } else { die "parse $_" } }' backup.dat > backup.vcf
##
##
BEGIN:VCARD
VERSION:2.1
N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;BME=20k=C3=B6zponti;;;
FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:BME=20k=C3=B6zponti
TEL;CELL:CELL:+3614631111
END:VCARD