http://kldp.org/node/98881#comment-462014
http://web.suapapa.net:8080/wordpress/?p=391
에서 사랑의 이름궁합을 Python으로 만들 걸 보고 재미있겠다 싶어 Perl로 한 번 만들어 봤음~

suapapa님은 ㅈ를 2획 ㅊ을 3획으로 했던데 http://www.happyname.co.kr/name/index_name_08.htm 을 보면 ㅈ는 3획 ㅊ는 4획 이 맞는 것 같아서 고침.

온라인상에서 해보기 -> http://aero.dnip.net/love

참고:
Lingua::KO::Hangul::Util 모듈

http://www.kfunigraz.ac.at/~katzer/korean_hangul_unicode.html


<LoveMatching.pm 모듈>

package LoveMatching;

use strict;
use warnings;
use utf8;
use Lingua::KO::Hangul::Util qw/:all/;
use base qw/Exporter/;

use version; our $VERSION = qv("0.0.1");

our @EXPORT_OK = qw/match_by_name/;

sub match_by_name {
    my ($name1,$name2) = @_;
    my @name1chars = split //, $name1;
    my @name2chars = split //, $name2;
    my @namepool;
    while (@name1chars) {
        push @namepool, shift @name1chars;
        push @namepool, shift @name2chars;
    }
    binmode STDOUT, ':encoding(UTF-8)';
    print "@namepool\n";
    my @cntpool = map { get_stroke_count($_) } @namepool;
    print love_sum( @cntpool ), " %\n";
}

sub love_sum {
    my @cnts = @_;
    print "[", join(' ,', @cnts),"]\n";
    if ( (join '',@cnts) > 100 ) {
        my @newcnts;
        foreach ( 0 .. $#cnts-1 ) {
            push @newcnts, ($cnts[$_]+$cnts[$_+1]) % 10;
        }
        return love_sum(@newcnts);
    }
    else {
        return (join '', @cnts)+0;
    }
}

sub get_stroke_count {
    my ($chr) = @_;
    my %stroke_cnt = (
        #초성
        "\x{1100}" => 1, "\x{1102}" => 1, "\x{1103}" => 2, "\x{1105}" => 3,  # ㄱㄴㄷㄹ
        "\x{1106}" => 3, "\x{1107}" => 4, "\x{1109}" => 2, "\x{110B}" => 1,  # ㅁㅂㅅㅇ
        "\x{110C}" => 3, "\x{110E}" => 4, "\x{110F}" => 2, "\x{1110}" => 3,  # ㅈㅊㅋㅌ
        "\x{1111}" => 4, "\x{1112}" => 3,                                    # ㅍㅎ
        #중성
        "\x{1161}" => 2, "\x{1163}" => 3, "\x{1165}" => 2, "\x{1167}" => 3,  # ㅏㅑㅓㅕ
        "\x{1169}" => 2, "\x{116D}" => 3, "\x{116E}" => 2, "\x{1172}" => 3,  # ㅗㅛㅜㅠ
        "\x{1173}" => 1, "\x{1175}" => 1,                                    # ㅡㅣ
        #종성
        "\x{11A8}" => 1, "\x{11AB}" => 1, "\x{11AE}" => 2, "\x{11AF}" => 3,  # ㄱㄴㄷㄹ
        "\x{11B7}" => 3, "\x{11B8}" => 4, "\x{11BA}" => 2, "\x{11BC}" => 1,  # ㅁㅂㅅㅇ
        "\x{11BD}" => 3, "\x{11BE}" => 4, "\x{11BF}" => 2, "\x{11C0}" => 3,  # ㅈㅊㅋㅌ
        "\x{11C1}" => 4, "\x{11C2}" => 3,                                    # ㅍㅎ
    );

    my @jamos = map { split //, decomposeJamo($_) } split //, decomposeSyllable($chr);
    my $strokes = 0;
    foreach (@jamos) { $strokes += $stroke_cnt{$_} }
    return $strokes;
}

1;

<LoveMatching_test.pl 테스트코드>

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use LoveMatching qw/match_by_name/;

match_by_name("이명박","강만수");

<결과>
>perl LoveMatching_test.pl
이 강 명 만 박 수
[2 ,4 ,7 ,6 ,7 ,4]
[6 ,1 ,3 ,3 ,1]
[7 ,4 ,6 ,4]
[1 ,0 ,0]
100 %

<명령행에서 실행 예>
>perl -MLoveMatching=match_by_name -Mutf8 -e 'match_by_name("연정훈","한가인")'
연 한 정 가 훈 인
[5 ,6 ,6 ,3 ,6 ,3]
[1 ,2 ,9 ,9 ,9]
[3 ,1 ,8 ,8]
[4 ,9 ,6]
[3 ,5]
35 %