line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Convert::Number::Coptic; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
7222
|
use utf8; # can't find a way to conditionally load this with |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
5
|
|
4
|
|
|
|
|
|
|
# the scope applying throughout |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
BEGIN |
7
|
|
|
|
|
|
|
{ |
8
|
1
|
|
|
1
|
|
29
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
9
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION @CNumbers %CNumbers); |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
318
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
2
|
$VERSION = "0.13"; |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
|
|
18
|
require 5.000; |
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
|
|
8
|
@CNumbers =( |
16
|
|
|
|
|
|
|
["α", "β", "γ", "δ", "ε", "ϛ", "ζ", "η", "θ"], |
17
|
|
|
|
|
|
|
["ι", "κ", "λ", "μ", "ν", "ξ", "ο", "π", "ϥ"], |
18
|
|
|
|
|
|
|
["ρ", "ϲ", "τ", "υ", "φ", "χ", "ψ", "ω", "ϣ"] |
19
|
|
|
|
|
|
|
); |
20
|
1
|
|
|
|
|
827
|
%CNumbers =( |
21
|
|
|
|
|
|
|
'α' => 1, |
22
|
|
|
|
|
|
|
'β' => 2, |
23
|
|
|
|
|
|
|
'γ' => 3, |
24
|
|
|
|
|
|
|
'δ' => 4, |
25
|
|
|
|
|
|
|
'ε' => 5, |
26
|
|
|
|
|
|
|
'ϛ' => 6, |
27
|
|
|
|
|
|
|
'ζ' => 7, |
28
|
|
|
|
|
|
|
'η' => 8, |
29
|
|
|
|
|
|
|
'θ' => 9, |
30
|
|
|
|
|
|
|
'ι' => 10, |
31
|
|
|
|
|
|
|
'κ' => 20, |
32
|
|
|
|
|
|
|
'λ' => 30, |
33
|
|
|
|
|
|
|
'μ' => 40, |
34
|
|
|
|
|
|
|
'ν' => 50, |
35
|
|
|
|
|
|
|
'ξ' => 60, |
36
|
|
|
|
|
|
|
'ο' => 70, |
37
|
|
|
|
|
|
|
'π' => 80, |
38
|
|
|
|
|
|
|
'ϥ' => 90, |
39
|
|
|
|
|
|
|
'ρ' => 100, |
40
|
|
|
|
|
|
|
'ϲ' => 200, |
41
|
|
|
|
|
|
|
'τ' => 300, |
42
|
|
|
|
|
|
|
'υ' => 400, |
43
|
|
|
|
|
|
|
'φ' => 500, |
44
|
|
|
|
|
|
|
'χ' => 600, |
45
|
|
|
|
|
|
|
'ψ' => 700, |
46
|
|
|
|
|
|
|
'ω' => 800, |
47
|
|
|
|
|
|
|
'ϣ' => 900 |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _setArgs |
54
|
|
|
|
|
|
|
{ |
55
|
190
|
|
|
190
|
|
173
|
my $self = shift; |
56
|
|
|
|
|
|
|
|
57
|
190
|
50
|
|
|
|
395
|
if ( $#_ ) { |
58
|
0
|
|
|
|
|
0
|
warn ( "too many arguments." ); |
59
|
0
|
|
|
|
|
0
|
return; |
60
|
|
|
|
|
|
|
} |
61
|
190
|
|
|
|
|
233
|
my $number = shift; |
62
|
190
|
50
|
66
|
|
|
1083
|
unless ( ($number =~ /^\d+$/) || ($number =~ /([α-ρς-ωϛϲ])/) ) { |
63
|
0
|
|
|
|
|
0
|
warn ( "$number is not a number." ); |
64
|
0
|
|
|
|
|
0
|
return; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
190
|
|
|
|
|
279
|
$self->{number} = $number; |
68
|
|
|
|
|
|
|
|
69
|
190
|
|
|
|
|
422
|
1; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub new |
74
|
|
|
|
|
|
|
{ |
75
|
1
|
|
|
1
|
0
|
138
|
my $class = shift; |
76
|
1
|
|
|
|
|
4
|
my $self = {}; |
77
|
|
|
|
|
|
|
|
78
|
1
|
|
|
|
|
7
|
my $blessing = bless ( $self, $class ); |
79
|
|
|
|
|
|
|
|
80
|
1
|
|
|
|
|
7
|
$self->{number} = undef; |
81
|
|
|
|
|
|
|
|
82
|
1
|
50
|
0
|
|
|
4
|
$self->_setArgs ( @_ ) || return if ( @_ ); |
83
|
|
|
|
|
|
|
|
84
|
1
|
|
|
|
|
4
|
$blessing; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub _fromCoptic |
89
|
|
|
|
|
|
|
{ |
90
|
95
|
|
|
95
|
|
144
|
$_ = $_[0]->{number}; |
91
|
95
|
|
|
|
|
284
|
s/̄//og; |
92
|
95
|
|
|
|
|
240
|
s/̱/000/og; |
93
|
95
|
|
|
|
|
197
|
s/͇/000000/og; |
94
|
95
|
|
|
|
|
906
|
s/([α-ρς-ωϛϲ])/$CNumbers{$1}/og; |
95
|
|
|
|
|
|
|
|
96
|
95
|
|
|
|
|
123
|
my $out = 0; |
97
|
95
|
|
|
|
|
326
|
s/(\d0+)/$out += $1/oge; |
|
252
|
|
|
|
|
904
|
|
98
|
95
|
|
|
|
|
329
|
s/(\d)$/$out += $1/oe; |
|
95
|
|
|
|
|
245
|
|
99
|
|
|
|
|
|
|
|
100
|
95
|
|
|
|
|
239
|
$out; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub toCoptic |
105
|
|
|
|
|
|
|
{ |
106
|
95
|
|
|
95
|
0
|
158
|
my $number = $_[0]->{number}; |
107
|
|
|
|
|
|
|
|
108
|
95
|
|
|
|
|
121
|
my $n = length ( $number ) - 1; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# map and return a single digit number |
111
|
|
|
|
|
|
|
# don't waste time with the loop: |
112
|
95
|
100
|
|
|
|
188
|
return ( "$CNumbers[0][$number-1]̄" ) unless ( $n ); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
91
|
|
|
|
|
345
|
my @aNumberString = split ( //, $number ); |
116
|
91
|
|
|
|
|
133
|
my $cNumberString = ""; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# |
120
|
|
|
|
|
|
|
# read number from most to least significant digits: |
121
|
|
|
|
|
|
|
# |
122
|
91
|
|
|
|
|
191
|
for ( my $place = $n; $place >= 0; $place-- ) { |
123
|
|
|
|
|
|
|
|
124
|
582
|
|
|
|
|
609
|
my $pos = $place % 3; |
125
|
582
|
|
|
|
|
623
|
my $cycles = int $place / 3; |
126
|
|
|
|
|
|
|
|
127
|
582
|
|
|
|
|
665
|
my $aNum = $aNumberString[$n-$place]; |
128
|
582
|
100
|
|
|
|
1212
|
next unless ( $aNum ); |
129
|
305
|
|
|
|
|
512
|
$cNumberString .= $CNumbers[$pos][$aNum-1]; |
130
|
|
|
|
|
|
|
|
131
|
305
|
100
|
|
|
|
424
|
if ( $cycles ) { |
132
|
|
|
|
|
|
|
# |
133
|
|
|
|
|
|
|
# add an even number of = symbols |
134
|
|
|
|
|
|
|
# |
135
|
171
|
|
|
|
|
374
|
for ( my $i = 0; $i<(int $cycles/2); $i++ ) { |
136
|
75
|
|
|
|
|
179
|
$cNumberString .= "͇"; |
137
|
|
|
|
|
|
|
} |
138
|
171
|
100
|
|
|
|
514
|
$cNumberString .= "̱" if ( $cycles % 2 ); # if odd |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
else { |
141
|
134
|
|
|
|
|
320
|
$cNumberString .= "̄"; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
91
|
|
|
|
|
331
|
$cNumberString; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub convert |
151
|
|
|
|
|
|
|
{ |
152
|
190
|
|
|
190
|
0
|
499
|
my $self = shift; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# |
155
|
|
|
|
|
|
|
# reset string if we've been passed one: |
156
|
|
|
|
|
|
|
# |
157
|
190
|
100
|
|
|
|
399
|
$self->number ( @_ ) if ( @_ ); |
158
|
|
|
|
|
|
|
|
159
|
190
|
100
|
|
|
|
312
|
( $self->number =~ /^[0-9]+$/ ) |
160
|
|
|
|
|
|
|
? $self->toCoptic |
161
|
|
|
|
|
|
|
: $self->_fromCoptic |
162
|
|
|
|
|
|
|
; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub number |
167
|
|
|
|
|
|
|
{ |
168
|
380
|
|
|
380
|
0
|
5046
|
my $self = shift; |
169
|
|
|
|
|
|
|
|
170
|
380
|
100
|
50
|
|
|
851
|
$self->_setArgs ( @_ ) || return |
171
|
|
|
|
|
|
|
if ( @_ ); |
172
|
|
|
|
|
|
|
|
173
|
380
|
|
|
|
|
1108
|
$self->{number}; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
######################################################### |
178
|
|
|
|
|
|
|
# Do not change this, Do not put anything below this. |
179
|
|
|
|
|
|
|
# File must return "true" value at termination |
180
|
|
|
|
|
|
|
1; |
181
|
|
|
|
|
|
|
########################################################## |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
__END__ |