File Coverage

lib/Convert/Number/Coptic.pm
Criterion Covered Total %
statement 59 63 93.6
branch 17 20 85.0
condition 3 7 42.8
subroutine 10 10 100.0
pod 0 4 0.0
total 89 104 85.5


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__