convert docomo vcard format to ldif

dcmvcf2ldif.pl

#!/usr/bin/perl
# convert docomo vcard format to ldif

use utf8;
use strict;
use warnings;
use Unicode::Normalize;
binmode(STDOUT, ':utf8');

die 'error: no vcard file specified (*.vcf)' if (@ARGV < 1);
my (undef, @lines) = read_vcf($ARGV[0]);
my $vcard_no = 0, my $content = NFKC(join '', @lines);
for ($content =~ /BEGIN:VCARD\n(.*?)END:VCARD\n/sg) {
    $vcard_no++;
    my @buffer = ('dn: ',
        'objectclass: top',
        'objectclass: person',
        'objectclass: organizationalPerson',
        'objectclass: inetOrgPerson');

    if (/^N(?:;[^:]*)?:(.+?);*$/m) {
        my ($sn, $given) = split ' ', $1, 2;
        push @buffer, "cn: $1";
        push @buffer, "sn: $sn";
        push @buffer, "givenName: $given" if ($given);
    } else {
        print STDERR "skip: vcard #$vcard_no: no N property\n";
        next;
    }

    if (/^SOUND(?:;[^:]*)?:(.+?);*$/m) {
        my ($sn, $given) = split ' ', $1, 2;
        push @buffer, "cn;lang-ja;phonetic: $1";
        push @buffer, "sn;lang-ja;phonetic: $sn";
        push @buffer, "givenName;lang-ja;phonetic: $given" if ($given);
    }

    if (/^X-NO(?:;[^:]*)?:(.+?)$/m) {
        $buffer[0] .= "employeeNumber=$1";
        push @buffer, "employeeNumber: $1";
    } else {
        print STDERR "skip: vcard #$vcard_no: no X-NO property\n";
        next;
    }

    if (/^X-GN(?:;[^:]*)?:(.+?)$/m) {
        $buffer[0] .= ",ou=$1";
        push @buffer, "ou: $1";
    } else {
        print STDERR "skip: vcard #$vcard_no: no X-GN property\n";
        next;
    }

    push @buffer, "description: $1"     if (/^NOTE(?:;[^:]*)?:(.+?)$/m);
    push @buffer, "telephoneNumber: $_" for (/^TEL(?:;[^:]*)?:(.+?)$/mg);
    push @buffer, "mail: $_"            for (/^EMAIL(?:;[^:]*)?:(.+?)$/mg);

    print join("\n", @buffer) . "\n\n";
}

# read a vcf, unfolding split lines and removing empty-value properties
sub read_vcf {
    my $filename = shift, my @lines = ();
    open my $fh, '<:encoding(cp932):crlf', $filename;
    for (my $curr = <$fh>, my $next; defined $curr; $curr = $next) {
        while (defined($next = <$fh>) and $next =~ s/^[ \t]+|^$//) {
            chomp $curr;
            $curr .= $next;
        }
        push @lines, $curr unless ($curr =~ /:;*$/);
    }
    close $fh;
    return @lines;
}