package Lingua::ZH::ChineseNaming; use 5.006; use strict; use Carp; our $VERSION = '0.02'; require Exporter; our @ISA = qw/Exporter/; my $CHARS; my %STROKEDB; sub is_Big5_CHAR { local $_=shift; 1 if /^[\xA4-\xC5][\x40-\x7E]/o || /^[\xA4-\xC5][\xA1-\xFE]/o || /^\xA3[\x40-\x7E]/o || /^[\xA4-\xC5][\x40-\x7E]/o || /^[\xA4-\xC5][\xA1-\xFE]/o; } sub loadchar{ my $i = 1; foreach my $s (split /\n/, $CHARS){ foreach ( grep {$_} split /\s/, $s ){ $STROKEDB{$_} = $i; } $i++; } } sub strokes{ [ map { $STROKEDB{$1} } $_[0]=~/(..)/og ]; } sub analyze{ my (%arg) = @_; my (%ch); my ($fn, $gn) = ($arg{FAMILY_NAME}, $arg{GIVEN_NAME}); my ($stfn, $stgn) = (strokes($fn), strokes($gn)); no strict; my (%handle) = ( 22 => sub { %ch = ( heavenly => $stfn->[0] + 1, personal => $stfn->[0] + $stgn->[0], earthly => $stgn->[0] + 1, external => 2, general => $stfn->[0] + $stgn->[0] + 2 ); }, 24 => sub { %ch = ( heavenly => $stfn->[0] + 1, personal => $stfn->[0] + $stgn->[0], earthly => $stgn->[0] + $stgn->[1], external => 1 + $stgn->[1], general => $stfn->[0] + $stgn->[0] + $stgn->[1] +1 ); }, 42 => sub { %ch = ( heavenly => $stfn->[0] + $stfn->[1], personal => $stfn->[1] + $stgn, earthly => $stgn + 1, external => 2, general => $stfn->[0] + $stfn->[1] + $stgn->[0] + 1 ); }, 44 => sub { %ch = ( heavenly => $stfn->[0] + $stfn->[1], personal => $stfn->[1] + $stgn->[0], earthly => $stgn->[0] + $stgn->[1], external => $stgn->[1] + 1, general => $stfn->[0] + $stfn->[1] + $stgn->[0] + $stgn->[1], ); }, ); (%arg, $handle{length($fn).length($gn)}->($fn, $gn)); } sub hexagram{ my (%arg) = @_; my (@ba_gua) = qw/qian dui li zhen xun kan gen kun/; my (@yinyang)=qw/--------- -x------- ----x---- -x--x---- -------x- -x-----x- ----x--x- -x--x--x-/; my $stgn = strokes($arg{GIVEN_NAME}); my ($upper, $lower) = ( $arg{general} % 8, ($stgn->[0] + $stgn->[1]) % 8 ); (%arg, ( hexagram => $ba_gua[ $upper ]." over ".$ba_gua[ $lower ], diagram => join qq/\n/, map{ s/x/ /o;$_ } map { $yinyang[$_] =~ /(...)(...)(...)/o; $1,$2,$3 } $upper, $lower)); } sub new{ my($pkg) = shift; my(%arg) = @_; my %r; $r{FAMILY_NAME} = $arg{FAMILY_NAME} or croak "Family name?"; $r{GIVEN_NAME} = $arg{GIVEN_NAME} or croak "Given name?"; loadchar(); %r = analyze(%r); %r = hexagram(%r); bless \%r, $pkg; } 1; $CHARS=< '³¯', GIVEN_NAME => '¶ê¶ê' ); print Dumper $n; =head1 DESCRIPTION Naming is an art and choosing an auspicious one is a long-standing tradition in Chinese communities. Many people hold firmly that to have a good name is to have an auspicious life. Analyzing and choosing a good name always uses several patterns, e.g. stroke-counting, Chinese-horoscope, hexagrams, but there is never a scientific foundation for these patterns. Lingua::ZH::ChineseNaming avoids to be a fortune-teller, but only extracts the computable part of this tradition and tries not to be confined to any specific school of interpreters. =head1 METHODS =over 1 =item * new Lingua::ZH::ChineseNaming(FAMILY_NAME => HERE, GIVEN_NAME => HERE) starts analysis my $n = new Lingua::ZH::ChineseNaming( # Chen Yuan-yuan FAMILY_NAME => '³¯', GIVEN_NAME => '¶ê¶ê' ); then, it gives statistics like this. FAMILY_NAME => '³¯', # Chen GIVEN_NAME => '¶ê¶ê', # Yuan-yuan heavenly => 12, personal => 24 earthly => 26, external => 14, general => 38, hexagram => 'gen over li', chart => '--- - - - - --- - - ---' =back =head1 ILLUSTRATIONS =over 8 =item * FAMILY NAME Chinese family names are mostly a single character. =item * GIVEN NAME comes in one or two characters. =item * HEAVENLY CHARACTER implies the influence of ancestry on a person. =item * PERSONAL CHARACTER implies one's disposition or inner attributes. =item * EARTHLY CHARACTER implies the relation between the environment and person =item * EXTERNAL CHARACTER is combined with one's heavenly character and earthly character, representing the external factors of one person. =item * GENERAL CHARACTER is addition of one's heavenly, personal, and earthly characters. =item * HEXAGRAM is formally introduced to history in I-CHING thousand years ago, and is given for your own interpretation. =back =head1 CAVEAT =over 2 =item * It is only for casual amusement. No practical use =item * Characters are all encoded in Big5 for now. =back =head1 REFERENCE Almost every kind of book on Chinese naming is written in Chinese. I list two books in English for you reference. =over 2 =item * Choosing Auspicious Chinese Name by Evelyn Lip =item * I CHING, The Oracle by Kerson Huang =back =head1 COPYRIGHT xern Exern@cpan.orgE This module is free software; you can redistribute it or modify it under the same terms as Perl itself. =cut