連絡先.app から ストラップフォン2 へ電話帳を転送します

vcard_to_h_donya.pl

#!/usr/bin/env perl

use utf8;
use Modern::Perl;

use Data::Dumper;
use Docopt;
use Encode;
use IO::All;
use Lingua::JA::Kana;
use List::MoreUtils qw(any);
use Text::CSV::Encoded;
use Text::vCard::Addressbook;
use Unicode::EastAsianWidth;
use YAML::Syck;

sub is_ascii {
    $_[0] !~ /[^[:ascii:]]/;
}

sub run {
    my $opts = docopt();

    #local $YAML::Syck::ImplicitUnicode = 1;
    #binmode STDOUT, ":utf8";

    my $address_book = Text::vCard::Addressbook->new(
        { 
            source_file  => $opts->{'<vcf_file>'},
        },
    );

    my @fields = split /,/, 'グループ,種別,名前(漢字),名前(カナ),電話番号1,電話番号2,電話番号3,電話番号4,電話番号5,電話番号6,メールアドレス1,メールアドレス2,メールアドレス3,メールアドレス4,メールアドレス5,メールアドレス6,シークレット';
    my @rows;

    for my $vcard ( $address_book->vcards ) {
        my %hash;

        my $kanji = do {
            my @values = 
                grep $_,
                map {
                    my $node = $_;
                    map {
                        my $field = $_;
                        $node->$field;
                    } @{$node->{field_order}};
                } $vcard->get('N');

            unless (@values) {
                push @values, $vcard->fullname;
            }

            if ( any { is_ascii $_ } @values ) {
                @values = reverse @values;
            }

            join " ", @values;
        };

        my $kana = do {
            my $yomi = join " ", map { $_->value } grep $_, $vcard->get('X-PHONETIC-LAST-NAME');
            my $str = $yomi || $kanji;
            $str = zenkaku2hankaku(hiragana2katakana($str));
            $str =~ s/\p{InFullwidth}/_/g;
            $str;
        };

        my @phones = map { $_->value } grep $_, $vcard->get( { node_type => 'phones' } );
        my @emails = map { $_->value } grep $_, $vcard->get( { node_type => 'email' } );

        #say "$kanji [$kana]";

        $hash{'名前(漢字)'}              = $kanji;
        $hash{'名前(カナ)'}              = $kana; # wx06a だとここを埋めないと転送しても、表示されない
        $hash{"電話番号"       . ($_+1)} = $phones[$_] for 0..$#phones;
        $hash{"メールアドレス" . ($_+1)} = $emails[$_] for 0..$#emails;

        push @rows, \%hash;
    }

    #say Dump \@rows;

    my $csv = Text::CSV::Encoded->new ({
        encoding_out => "cp932",
    });
    #$csv->combine(@fields) or die $csv->error_diag;
    #say $csv->string;
    for my $row (@rows) {
        $csv->combine( map { $row->{$_} // "" } @fields ) or die $csv->error_diag;
        say $csv->string;
    }
}

run();

__END__

=head1 SYNOPSIS

    vcard_to_h_donya.pl <vcf_file>


=head1 EXAMPLE

    連絡先.app で vcf ファイルを書き出す。

    vcard_to_h_donya.pl <vcf_file> > cp932.csv

    cp932.csv を H"問屋 にインポート。

    転送。

=head1 MEMO

    H"問屋でエクスポート時のCSVヘッダ
    グループ,種別,名前(漢字),名前(カナ),電話番号1,電話番号2,電話番号3,電話番号4,電話番号5,電話番号6,メールアドレス1,メールアドレス2,メールアドレス3,メールアドレス4,メールアドレス5,メールアドレス6,シークレット

    H"問屋では、フィールド「生年月日」や「血液型」などが扱えるが
    CSVエクスポート時には欠落している。

    独自の保存形式 電話帳ファイル (*.had) というものも用意されているが、ここではCSVを選択。

    Windows XP SP3 32bit on VMware Fusion 6.0.3 (1747349) on Mac OX X 10.9.2 だと、シリアル通信が上手くできず、下のエラーで止まってしまう。
        データ転送がタイムアウトにより中断しました。(D00028) 
    特定の件数で止まるのだが、ダメ文字がある訳ではなさそう。

    試しに Windows 7 64bit on 同上 で試したら、正常に転送できた。