File Coverage

blib/lib/Crypt/Hill/Utils.pm
Criterion Covered Total %
statement 74 82 90.2
branch 3 4 75.0
condition n/a
subroutine 13 15 86.6
pod 0 6 0.0
total 90 107 84.1


line stmt bran cond sub pod time code
1             package Crypt::Hill::Utils;
2              
3             $Crypt::Hill::Utils::VERSION = '0.10';
4             $Crypt::Hill::Utils::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Crypt::Hill::Utils - Utils package for Crypt::Hill.
9              
10             =head1 VERSION
11              
12             Version 0.10
13              
14             =cut
15              
16 3     3   71 use 5.006;
  3         11  
17 3     3   21 use strict; use warnings;
  3     3   25  
  3         79  
  3         18  
  3         8  
  3         124  
18 3     3   21 use Data::Dumper;
  3         7  
  3         141  
19 3     3   808 use parent 'Exporter';
  3         890  
  3         17  
20              
21             our @EXPORT_OK = qw(to_matrix_2_x_1
22             to_matrix_1_x_2
23             inverse_matrix
24             generate_table
25             get_determinant
26             multiply_mod);
27              
28             =head1 DESCRIPTION
29              
30             B
31              
32             =cut
33              
34             sub to_matrix_2_x_1 {
35 2     2 0 4 my ($message, $chars, $table, $size) = @_;
36              
37 2         4 my @keys = _generate_keys($chars, $message, $size);
38 2         4 my $index = 0;
39 2         3 my $matrix = [];
40              
41 2         11 while ($index < scalar(@keys)) {
42 4         6 my $_matrix = [];
43 4         9 $_matrix->[0][0] = $table->{$keys[$index]};
44 4         8 $_matrix->[1][0] = $table->{$keys[$index+1]};
45 4         7 push @$matrix, $_matrix;
46 4         8 $index += $size;
47             }
48              
49 2         5 return $matrix;
50             }
51              
52             sub to_matrix_1_x_2 {
53 2     2 0 6 my ($message, $chars, $table, $size) = @_;
54              
55 2         8 my @keys = _generate_keys($chars, $message, $size);
56 2         4 my $index = 0;
57 2         4 my @matrix = ();
58              
59 2         7 while ($index < scalar(@keys)) {
60 4         8 my $_matrix = [];
61 4         9 $_matrix->[0] = $table->{$keys[$index]};
62 4         10 $_matrix->[1] = $table->{$keys[$index+1]};
63 4         6 push @matrix, $_matrix;
64 4         9 $index += $size;
65             }
66              
67 2         5 return \@matrix;
68             }
69              
70             sub inverse_matrix {
71 1     1 0 3 my ($matrix, $modulus) = @_;
72              
73 1         2 my $determinant = get_determinant($matrix);
74 1         3 my $mod_inv = _get_mod_inverse($determinant, $modulus);
75 1         2 my $first = $matrix->[0][0];
76 1         2 my $last = $matrix->[1][1];
77 1         2 $matrix->[0][0] = $last;
78 1         2 $matrix->[1][1] = $first;
79 1         2 $matrix->[0][1] *= -1;
80 1         2 $matrix->[1][0] *= -1;
81              
82 1         2 my $inv_matrix = [];
83 1         3 foreach my $row (0..1) {
84 2         5 foreach my $col (0..1) {
85 4         9 $inv_matrix->[$row][$col] = ($matrix->[$row][$col] * $mod_inv) % $modulus;
86             }
87             }
88              
89 1         3 return $inv_matrix;
90             }
91              
92             sub generate_table {
93 4     4 0 7 my ($chars) = @_;
94              
95 4         8 my $table = {};
96 4         7 my $index = 0;
97 4         8 foreach (@$chars) {
98 104         166 $table->{$_} = $index++;
99             }
100              
101 4         58 return $table;
102             }
103              
104             sub get_determinant {
105 3     3 0 7 my ($matrix) = @_;
106              
107 3         27 return (($matrix->[0][0] * $matrix->[1][1]) - ($matrix->[0][1] * $matrix->[1][0]));
108             }
109              
110             sub multiply_mod {
111 4     4 0 6 my ($matrix, $by, $mod) = @_;
112              
113 4         6 my $_matrix = [];
114 4         12 $_matrix->[0][0] = ($matrix->[0][0] * $by->[0][0] + $matrix->[0][1] * $by->[1][0]);
115 4         10 $_matrix->[1][0] = ($matrix->[1][0] * $by->[0][0] + $matrix->[1][1] * $by->[1][0]);
116 4         5 $_matrix->[0][0] %= $mod;
117 4         6 $_matrix->[1][0] %= $mod;
118              
119 4         6 return $_matrix;
120             }
121              
122             #
123             #
124             # PRIVATE METHODS
125              
126             sub _generate_random_number {
127 0     0   0 my ($min, $max) = @_;
128              
129 0         0 return int($min + rand($max - $min));
130             }
131              
132             sub _generate_random_characters {
133 0     0   0 my ($charsets, $count) = @_;
134              
135 0         0 my @chars = @$charsets;
136 0         0 my $min = 1;
137 0         0 my $max = scalar(@chars);
138              
139 0         0 return @chars[ map { _generate_random_number($min, $max) } (1..$count) ];
  0         0  
140             }
141              
142             sub _get_mod_inverse {
143 1     1   3 my ($determinant, $mod) = @_;
144              
145 1         2 $determinant %= $mod;
146 1         3 for my $i (1..($mod-1)) {
147 3 100       9 return $i if (($determinant * $i) % $mod == 1);
148             }
149             }
150              
151             sub _generate_keys {
152 4     4   10 my ($charsets, $key, $size) = @_;
153              
154 4         12 my @keys = split //, $key;
155 4         10 my $mod = scalar(@keys) % $size;
156 4 50       10 push @keys, _generate_random_characters($charsets, $mod) if ($mod > 0);
157              
158 4         11 return @keys;
159             }
160              
161             =head1 AUTHOR
162              
163             Mohammad S Anwar, C<< >>
164              
165             =head1 REPOSITORY
166              
167             L
168              
169             =head1 BUGS
170              
171             Please report any bugs/feature requests to C or
172             through the web interface at L.
173             I will be notified & then you'll automatically be notified of progress on your bug
174             as I make changes.
175              
176             =head1 SUPPORT
177              
178             You can find documentation for this module with the perldoc command.
179              
180             perldoc Crypt::Hill::Utils
181              
182             You can also look for information at:
183              
184             =over 4
185              
186             =item * RT: CPAN's request tracker
187              
188             L
189              
190             =item * AnnoCPAN: Annotated CPAN documentation
191              
192             L
193              
194             =item * CPAN Ratings
195              
196             L
197              
198             =item * Search CPAN
199              
200             L
201              
202             =back
203              
204             =head1 LICENSE AND COPYRIGHT
205              
206             Copyright (C) 2014 - 2017 Mohammad S Anwar.
207              
208             This program is free software; you can redistribute it and/or modify it under
209             the terms of the the Artistic License (2.0). You may obtain a copy of the full
210             license at:
211              
212             L
213              
214             Any use, modification, and distribution of the Standard or Modified Versions is
215             governed by this Artistic License.By using, modifying or distributing the Package,
216             you accept this license. Do not use, modify, or distribute the Package, if you do
217             not accept this license.
218              
219             If your Modified Version has been derived from a Modified Version made by someone
220             other than you,you are nevertheless required to ensure that your Modified Version
221             complies with the requirements of this license.
222              
223             This license does not grant you the right to use any trademark, service mark,
224             tradename, or logo of the Copyright Holder.
225              
226             This license includes the non-exclusive, worldwide, free-of-charge patent license
227             to make, have made, use, offer to sell, sell, import and otherwise transfer the
228             Package with respect to any patent claims licensable by the Copyright Holder that
229             are necessarily infringed by the Package. If you institute patent litigation
230             (including a cross-claim or counterclaim) against any party alleging that the
231             Package constitutes direct or contributory patent infringement,then this Artistic
232             License to you shall terminate on the date that such litigation is filed.
233              
234             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
235             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
236             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
237             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
238             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
239             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
240             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
241              
242             =cut
243              
244             1; # End of Crypt::Hill::Utils