#!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__