宛名職人V17でContactXML 1.1, utf-8で出力

atena-shokunin-xml.pl

#!/usr/bin/perl
# 宛名職人V17でContactXML 1.1, utf-8で出力

use Data::Dumper;
{
    package Data::Dumper;
    sub qquote { return shift; }
}
$Data::Dumper::Useperl = 1;

use XML::Simple;
use strict;
use warnings;

my $file = shift;
my $xs = new XML::Simple();
my $ref = $xs->XMLin($file);
binmode(STDOUT, ':utf8');

sub ev{
  my $e = shift;
	my $v = {};
	$v->{FullName} = $e->{PersonName}->{PersonNameItem}->{FullName}->{content};

	$v->{FirstName} =
		defined $e->{PersonName}->{PersonNameItem}->{FirstName}->{content} ?
		$e->{PersonName}->{PersonNameItem}->{FirstName}->{content} : '';
	$v->{LastName} =
		defined $e->{PersonName}->{PersonNameItem}->{LastName}->{content} ?
		$e->{PersonName}->{PersonNameItem}->{LastName}->{content} : '';

	$v->{FirstNamePronunciation} =
		defined $e->{PersonName}->{PersonNameItem}->{FirstName}->{pronunciation} ?
		$e->{PersonName}->{PersonNameItem}->{FirstName}->{pronunciation} : '';
	$v->{LastNamePronunciation} =
		defined $e->{PersonName}->{PersonNameItem}->{LastName}->{pronunciation} ?
		$e->{PersonName}->{PersonNameItem}->{LastName}->{pronunciation} : '';

	return $v;
}

################################################################
#   tel-type     = "HOME" / "WORK" / "PREF" / "VOICE" / "FAX" / "MSG"
#                / "CELL" / "PAGER" / "BBS" / "MODEM" / "CAR" / "ISDN"
#                / "VIDEO" / "PCS" / iana-token / x-name
sub print_phone{
	my $phone = shift;

	print 'TEL';

	if($phone->{usage} eq 'Private'){
		print ';TYPE=HOME';
	}elsif($phone->{usage} eq 'Official'){
		print ';TYPE=WORK';
	}

	if($phone->{phoneDevice} eq 'Fax'){
		print ';TYPE=FAX';
	}elsif($phone->{phoneDevice} eq 'Cellular'){
		print ';TYPE=CELL';
	}

	print ':' . $phone->{content} . "\n";
}

################################################################
for my $contact (@{$ref->{ContactXMLItem}}){

	my $v = ev($contact);
	print "BEGIN:VCARD\n";
	print "VERSION:3.0\n";

	printf("FN:%s\n", $v->{FullName});
	printf("N:%s;%s;;;\n", $v->{LastName}, $v->{FirstName});
	printf("X-PHONETIC-LAST-NAME:%s\n", $v->{FirstNamePronunciation});
	printf("X-PHONETIC-FIRST-NAME:%s\n", $v->{LastNamePronunciation});

	for my $address (@{$contact->{Address}->{AddressItem}}){
		if(! ref $address->{FullAddress}){
			print 'ADR';
			if($address->{locationType} eq 'Home'){
				print ';TYPE=HOME';
			}
			print ':';
			print ';;;;';
			print $address->{FullAddress};
			if($address->{AddressCode}->{content}){
				print ';' . $address->{AddressCode}->{content};
			}
			print ';';
			print "\n";
		}
	}

	if($contact->{Occupation}->{OccupationItem}->{OrganizationName}->{content}){
		print 'ORG:' .
			$contact->{Occupation}->{OccupationItem}->{OrganizationName}->{content} . ";;\n";
	}

	if(ref($contact->{Email}->{EmailItem}) eq 'HASH'){
		print 'EMAIL;INTERNET:' . $contact->{Email}->{EmailItem}->{content} . "\n";
	}elsif(ref($contact->{Email}->{EmailItem}) eq 'ARRAY'){
		for my $email (@{$contact->{Email}->{EmailItem}}){
			print 'EMAIL;INTERNET:' . $email->{content} . "\n";
		}
	}


	if(defined $contact->{Phone}){
		if(ref($contact->{Phone}->{PhoneItem}) eq 'HASH'){
			print_phone($contact->{Phone}->{PhoneItem});
		}elsif(ref($contact->{Phone}->{PhoneItem}) eq 'ARRAY'){
			for my $phone (@{$contact->{Phone}->{PhoneItem}}){
				print_phone($phone);
			}
		}
	}

	print "END:VCARD\n";
	print "\n";
}

__END__