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


line stmt bran cond sub pod time code
1             package ZHOUYI;
2 1     1   44071 use utf8;
  1         12  
  1         5  
3             require Exporter;
4 1     1   30 use strict;
  1         2  
  1         17  
5 1     1   4 use warnings;
  1         4  
  1         1024  
6              
7             our @ISA = qw(Exporter);
8             our @EXPORT = qw(ZhouyiEx ZYindex outGua sixyao outtuan outxiang maixyao maixiang);
9              
10             =encoding utf8
11             =head1 NAME
12              
13             ZHOUYI - The ZHOUYI is module interpreter and outer the Chinese ancient
14             philosophy of The Book of Change(易经);
15              
16             =head1 VERSION
17              
18             Version 0.12
19              
20             =cut
21              
22             our $VERSION = '0.12';
23              
24             =head1 SYNOPSIS
25              
26              
27             use ZHOUYI;
28              
29             my ( $num1, $mum2 )=@ARGV;
30             my $foo = ZhouyiEx( ZYindex( $mum2, $num1 ), 'ZhouYi') ;
31             print $foo;
32              
33             =head1 EXPORT
34              
35             ZhouyiEx ZYindex outGua sixyao outtuan outxiang maixyao maixiang
36              
37             A list of functions that can be exported. You can delete this section
38             if you don't export anything, such as for a purely object-oriented module.
39              
40              
41             =head1 SUBROUTINES/METHODS
42              
43             =head2 ZHouYiEx
44              
45             return YI info
46              
47             =head2 ZYindex
48              
49             return YI index of 1~81 gua.
50              
51             =head2 outGua outtuan sixyao outxiang
52              
53             return special gua's info of 卦体,爻,彖传,象辞.
54              
55             =head2 maixyao maixiang
56              
57             return special yao's info of 爻,象辞, and the it's array.
58              
59             =cut
60              
61             my ( $ZYdb, @ZYdb );
62              
63             @ZYdb = ;
64             $ZYdb .= $_ for @ZYdb;
65              
66             sub Bindex {
67 0     0 0   my ( @yigua, %yi, %zy, @bagua, @bagua1,@bgindex,@num);
68              
69 0           @bagua = qw(kun zhen kan dui gen li xun qian);
70 0           @bagua1 = qw(di lei shui ze shan huo feng tian);
71 0           @bgindex =
72             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);
73 0           @num =
74             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);
75              
76 0           @zy{@bgindex} = @num;
77 0           for ( 0 .. 63 ) {
78              
79 0           my $zindexs = sprintf( "%lo", $_ );
80 0           push @yigua, $zindexs;
81             }
82              
83 0           for (@yigua) {
84              
85 0 0         if (/^\d$/) {
86              
87 0           $yi{$_} = $bagua1[0] . "_" . $bagua1[$_];
88              
89             }
90             else {
91 0           my ( $q, $k ) = split //, $_;
92 0           $yi{$_} = $bagua1[$q] . "_" . $bagua1[$k];
93             }
94              
95             }
96              
97 0           return ( \%zy, \%yi );
98             }
99              
100             sub ZYindex {
101 0     0 1   my ( $wgua, $ngua ) = @_;
102 0           $wgua %= 8;
103 0           $ngua %= 8;
104 0           my ( @index, @bgindex, @num, %qiankun );
105              
106 0           @index = qw(di tian ze huo lei feng shui shan);
107 0           @bgindex =
108             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);
109 0           @num =
110             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);
111              
112 0           my $mindex = $index[$wgua] . "_" . $index[$ngua];
113 0           @qiankun{@bgindex} = @num;
114 0           return $qiankun{$mindex};
115             }
116              
117             sub ZhouyiEx {
118 0     0 0   my ( @line, $msg );
119 0           my $n = shift;
120 0           @line = split /^\s+$/sm, $ZYdb;
121 0           my $i;
122 0           for (@line) {
123 0           $i++;
124 0 0         $msg .= "$_\n" if $i == 2 * $n;
125 0 0         $msg .= "$_\n" if $i == 2 * $n + 1;
126             }
127              
128 0           return $msg;
129              
130             }
131              
132             sub outGua {
133 0     0 1   my $msg = shift;
134 0           my @guatext = split /\n/sm, $msg;
135 0           my $omsg .= $guatext[1] . "\n\n" . $guatext[4] . "\n\n";
136 0           return $omsg;
137             }
138              
139             sub sixyao {
140 0     0 1   my $msg = shift;
141 0           my @guatext = split /\n/sm, $msg;
142 0           my $omsg;
143 0           $omsg .= outGua($msg);
144 0           for (@guatext) {
145 0 0         next if /^$/;
146 0 0         next unless /^(初|六|九|上|用).:/;
147 0           $omsg .= $_ . "\n";
148             }
149 0           return $omsg;
150             }
151              
152             sub maixyao {
153 0     0 1   my ( $msg, $yao ) = @_;
154 0           my @guatext = split /\n/sm, $msg;
155 0           my @yaoci;
156 0           for (@guatext) {
157 0 0         next if /^$/;
158 0 0         next unless /^(初|六|九|上|用).:/;
159 0           push @yaoci, $_;
160             }
161 0           return ( $yaoci[$yao], \@yaoci );
162             }
163              
164             sub outtuan {
165              
166 0     0 1   my $msg = shift;
167 0           my @guatext = split /\n/sm, $msg;
168 0           my $omsg;
169 0           $omsg .= outGua($msg);
170 0           for (@guatext) {
171 0 0         next if /^$/;
172 0 0         next unless /《彖》/;
173 0           $omsg .= $_ . "\n";
174             }
175 0           return $omsg;
176              
177             }
178              
179             sub outxiang {
180 0     0 1   my $msg = shift;
181 0           my @guatext = split /\n/sm, $msg;
182 0           my $omsg;
183 0           $omsg .= outGua($msg);
184 0           for (@guatext) {
185 0 0         next if /^$/;
186 0 0         next unless /《象》/;
187 0           $omsg .= $_ . "\n";
188             }
189 0           return $omsg;
190              
191             }
192              
193             sub maixiang {
194 0     0 1   my ( $msg, $yao ) = @_;
195 0           my @guatext = split /\n/sm, $msg;
196 0           my @yaoci;
197 0           for (@guatext) {
198 0 0         next if /^$/;
199 0 0         next unless /《象》/;
200 0           push @yaoci, $_;
201             }
202 0           return ( $yaoci[$yao+1], \@yaoci );
203             }
204              
205             =head1 AUTHOR
206              
207             orange, C<< >>
208              
209             =head1 BUGS
210              
211             Please report any bugs or feature requests to C, or through
212             the web interface at L. I will be notified, and then you'll
213             automatically be notified of progress on your bug as I make changes.
214              
215              
216             =head1 SUPPORT
217              
218             You can find documentation for this module with the perldoc command.
219              
220             perldoc ZHOUYI
221              
222              
223             You can also look for information at:
224              
225             =over 4
226              
227             =item * RT: CPAN's request tracker (report bugs here)
228              
229             L
230              
231             =item * AnnoCPAN: Annotated CPAN documentation
232              
233             L
234              
235             =item * CPAN Ratings
236              
237             L
238              
239             =item * Search CPAN
240              
241             L
242              
243             =back
244              
245              
246             =head1 ACKNOWLEDGEMENTS
247              
248              
249             =head1 LICENSE AND COPYRIGHT
250              
251             Copyright 2016 orange.
252              
253             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
254              
255             =cut
256              
257             1;
258              
259             # End of ZHOUYI
260              
261             __DATA__