File Coverage

blib/lib/ZHOUYI.pm

Criterion	Covered	Total	%
statement	9	90	10.0
branch	0	26	0.0
condition			n/a
subroutine	3	12	25.0
pod	7	9	77.7
total	19	137	13.8

package ZHOUYI;
use utf8;
require Exporter;
use strict;
use warnings;

our @ISA    = qw(Exporter);
our @EXPORT = qw(ZhouyiEx ZYindex outGua sixyao outtuan outxiang maixyao maixiang);

=encoding utf8
=head1 NAME

ZHOUYI - The ZHOUYI is module interpreter and outer the Chinese ancient
philosophy of The Book of Change(易经);

=head1 VERSION

Version 0.14

=cut

our $VERSION = '0.14';

=head1 SYNOPSIS


    use ZHOUYI;

    my ( $num1, $mum2 )=@ARGV;
    my $foo = ZhouyiEx( ZYindex( $mum2, $num1 ), 'ZhouYi') ;
    print $foo;

=head1 EXPORT

ZhouyiEx ZYindex outGua sixyao outtuan outxiang maixyao maixiang

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.


=head1 SUBROUTINES/METHODS

=head2 ZHouYiEx

return YI info

=head2 ZYindex

return YI index of 1~81 gua.

=head2 outGua outtuan sixyao outxiang

return special  gua's info of 卦体，爻,彖传，象辞.

=head2 maixyao maixiang

return special yao's info of 爻,象辞, and the it's array.

=cut

my ( $ZYdb, @ZYdb );

@ZYdb = ;
$ZYdb .= $_ for @ZYdb;

sub Bindex {
    my ( @yigua, %yi, %zy, @bagua, @bagua1,@bgindex,@num);

    @bagua  = qw(kun zhen kan dui gen li xun qian);
    @bagua1 = qw(di lei shui ze shan huo feng tian);
    @bgindex =
      qw(tian_tian tian_ze tian_huo tian_lei tian_feng tian_shui tian_shan tian_di ze_tian ze_ze ze_huo ze_lei ze_feng ze_shui ze_shan ze_di huo_tian huo_ze huo_huo huo_lei huo_feng huo_shui huo_shan huo_di lei_tian lei_ze lei_huo lei_lei lei_feng lei_shui lei_shan lei_di feng_tian feng_ze feng_huo feng_lei feng_feng feng_shui feng_shan feng_di shui_tian shui_ze shui_huo shui_lei shui_feng shui_shui shui_shan shui_di shan_tian shan_ze shan_huo shan_lei shan_feng shan_shui shan_shan shan_di di_tian di_ze di_huo di_lei di_feng di_shui di_shan di_di);
    @num =
      qw(1 10 13 25 44 6 33 12 43 58  49 17 28 47 31 45 14 38 30 21 50 64 56 35 34 54 55 51 32 40 62 16 9 61 37 42 57 59 53 20 5 60 63 3 48 29 39 8 26 41 21 27 18 4 52 23 11 19 36 24 46 7 15 2);

    @zy{@bgindex} = @num;
    for ( 0 .. 63 ) {

        my $zindexs = sprintf( "%lo", $_ );
        push @yigua, $zindexs;
    }

    for (@yigua) {

        if (/^\d$/) {

            $yi{$_} = $bagua1[0] . "_" . $bagua1[$_];

        }
        else {
            my ( $q, $k ) = split //, $_;
            $yi{$_} = $bagua1[$q] . "_" . $bagua1[$k];
        }

    }

    return ( \%zy, \%yi );
}

sub ZYindex {
    my ( $wgua, $ngua ) = @_;
    $wgua %= 8;
    $ngua %= 8;
    my ( @index, @bgindex, @num, %qiankun );

    @index = qw(di tian ze huo lei feng shui shan);
    @bgindex =
      qw(tian_tian tian_ze tian_huo tian_lei tian_feng tian_shui tian_shan tian_di ze_tian ze_ze ze_huo ze_lei ze_feng ze_shui ze_shan ze_di huo_tian huo_ze huo_huo huo_lei huo_feng huo_shui huo_shan huo_di lei_tian lei_ze lei_huo lei_lei lei_feng lei_shui lei_shan lei_di feng_tian feng_ze feng_huo feng_lei feng_feng feng_shui feng_shan feng_di shui_tian shui_ze shui_huo shui_lei shui_feng shui_shui shui_shan shui_di shan_tian shan_ze shan_huo shan_lei shan_feng shan_shui shan_shan shan_di di_tian di_ze di_huo di_lei di_feng di_shui di_shan di_di);
    @num =
      qw(1 10 13 25 44 6 33 12 43 58  49 17 28 47 31 45 14 38 30 21 50 64 56 35 34 54 55 51 32 40 62 16 9 61 37 42 57 59 53 20 5 60 63 3 48 29 39 8 26 41 21 27 18 4 52 23 11 19 36 24 46 7 15 2);

    my $mindex = $index[$wgua] . "_" . $index[$ngua];
    @qiankun{@bgindex} = @num;
    return $qiankun{$mindex};
}

sub ZhouyiEx {
    my ( @line, $msg );
    my $n = shift;
    @line = split /^\s+$/sm, $ZYdb;
    my $i;
    for (@line) {
        $i++;
        $msg .= "$_\n" if $i == 2 * $n;
        $msg .= "$_\n" if $i == 2 * $n + 1;
    }

    return $msg;

}

sub outGua {
    my $msg = shift;
    my @guatext = split /\n/sm, $msg;
    my $omsg .= $guatext[1] . "\n\n" . $guatext[4] . "\n\n";
    return $omsg;
}

sub sixyao {
    my $msg = shift;
    my @guatext = split /\n/sm, $msg;
    my $omsg;
    $omsg .= outGua($msg);
    for (@guatext) {
        next if /^$/;
        next unless /^(初|六|九|上|用).：/;
        $omsg .= $_ . "\n";
    }
    return $omsg;
}

sub maixyao {
    my ( $msg, $yao ) = @_;
    my @guatext = split /\n/sm, $msg;
    my @yaoci;
    for (@guatext) {
        next if /^$/;
        next unless /^(初|六|九|上|用).：/;
        push @yaoci, $_;
    }
    return ( $yaoci[$yao], \@yaoci );
}

sub outtuan {

    my $msg = shift;
    my @guatext = split /\n/sm, $msg;
    my $omsg;
    $omsg .= outGua($msg);
    for (@guatext) {
        next if /^$/;
        next unless /《彖》/;
        $omsg .= $_ . "\n";
    }
    return $omsg;

}

sub outxiang {
    my $msg = shift;
    my @guatext = split /\n/sm, $msg;
    my $omsg;
    $omsg .= outGua($msg);
    for (@guatext) {
        next if /^$/;
        next unless /《象》/;
        $omsg .= $_ . "\n";
    }
    return $omsg;

}

sub maixiang {
    my ( $msg, $yao ) = @_;
    my @guatext = split /\n/sm, $msg;
    my @yaoci;
    for (@guatext) {
        next if /^$/;
        next unless /《象》/;
        push @yaoci, $_;
    }
    return ( $yaoci[$yao+1], \@yaoci );
}

=head1 AUTHOR

orange, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc ZHOUYI


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2016 orange.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

1;

# End of ZHOUYI

__DATA__