File Coverage

blib/lib/Crypt/Affine.pm
Criterion Covered Total %
statement 73 79 92.4
branch 17 28 60.7
condition 3 9 33.3
subroutine 13 13 100.0
pod 2 2 100.0
total 108 131 82.4


line stmt bran cond sub pod time code
1             package Crypt::Affine;
2              
3             $Crypt::Affine::VERSION = '0.13';
4             $Crypt::Affine::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Crypt::Affine - Interface to the Affine cipher.
9              
10             =head1 VERSION
11              
12             Version 0.13
13              
14             =cut
15              
16 6     6   53969 use 5.006;
  6         17  
17 6     6   1709 use autodie;
  6         76439  
  6         26  
18 6     6   45972 use Data::Dumper;
  6         34813  
  6         460  
19 6     6   2047 use Crypt::Affine::Params qw(FilePath ZeroOrOne PositiveNum);
  6         21  
  6         66  
20              
21 6     6   6164 use Moo;
  6         54978  
  6         36  
22 6     6   9871 use namespace::clean;
  6         51319  
  6         36  
23              
24             =head1 DESCRIPTION
25              
26             The affine cipher is a type of mono alphabetic substitution cipher, wherein each
27             letter in an alphabet is mapped to its numeric equivalent & then encrypted using
28             a simple mathematical function. It inherits the weaknesses of all substitution
29             ciphers. In the affine cipher the letters of an alphabet of size m are first
30             mapped to the integers in the range 0..m-1. It then uses modular arithmetic to
31             transform the integer that each plaintext letter corresponds to into another
32             integer that correspond to a ciphertext letter.The function for encryption of a
33             single letter can be defined as below:
34              
35             E(x) = (mx + r) % l
36              
37             where 'l' is the size of the alphabet and 'm' & 'r' are the key of cipher. The
38             value 'm' must be choosen such that 'm' and 'l' are coprime.
39              
40             Similarly the function for decryption of a single letter can be defined as below:
41              
42             D(x) = (m ^ -1) (x - r) % l
43              
44             where (m ^ -1) is the modular multiplicative inverse of 'm' modulo 'l' and it
45             satisfies the equation below:
46              
47             m (m ^ -1) % l = 1
48              
49             =cut
50              
51             has 'm' => (is => 'ro', isa => PositiveNum, required => 1 );
52             has 'r' => (is => 'ro', isa => PositiveNum, required => 1 );
53             has 'reverse' => (is => 'ro', isa => ZeroOrOne, default => sub { return 0; });
54             has 'source' => (is => 'ro', isa => FilePath);
55              
56             =head1 CONSTRUCTOR
57              
58             The constructor expects the following parameters as described below in the table:
59              
60             +----------+----------+-------------------------------------------------+
61             | Key | Required | Description |
62             +----------+----------+-------------------------------------------------+
63             | m | Yes | Any positive number. |
64             | r | Yes | Any positive number. |
65             | reverse | No | 0 or 1, depending whether to use reverse set of |
66             | | | alphabets. Default is 0. |
67             | source | No | Filename with complete path containing comma |
68             | | | separated list of alphabets. By default it uses |
69             | | | A-Z, a-z. |
70             +----------+----------+-------------------------------------------------+
71              
72             use strict; use warnings;
73             use Crypt::Affine;
74              
75             my $affine = Crypt::Affine->new({ m => 5, r => 8 });
76              
77             =head1 METHODS
78              
79             =head2 encrypt()
80              
81             Encrypts the given string of alphabets ignoring any non-alphabets.
82              
83             use strict; use warnings;
84             use Crypt::Affine;
85              
86             my $affine = Crypt::Affine->new({ m => 5, r => 8 });
87             my $original = 'affine cipher';
88             my $encrypted = $affine->encrypt($original);
89              
90             print "Original : [$original]\n";
91             print "Encrypted: [$encrypted]\n";
92              
93             =cut
94              
95             sub encrypt {
96 1     1 1 29 my ($self, $data) = @_;
97              
98 1 50       4 return unless defined $data;
99              
100 1 50       8 $self->_prepare() unless defined $self->{_a};
101 1         3 my $encrypt = '';
102 1         9 foreach (split //,$data) {
103 13 100       32 (_unsupported($_))
104             ?
105             ($encrypt .= $_)
106             :
107             ($encrypt .= $self->_encrypt($_));
108             }
109              
110 1         9 return $encrypt;
111             }
112              
113             =head2 decrypt()
114              
115             Decrypts the given string of alphabets ignoring any non-alphabets.
116              
117             use strict; use warnings;
118             use Crypt::Affine;
119              
120             my $affine = Crypt::Affine->new({ m => 5, r => 8 });
121             my $original = 'affine cipher';
122             my $encrypted = $affine->encrypt('affine cipher');
123             my $decrypted = $affine->decrypt($encrypted);
124              
125             print "Original : [$original]\n";
126             print "Encrypted: [$encrypted]\n";
127             print "Decrypted: [$decrypted]\n";
128              
129             =cut
130              
131             sub decrypt {
132 1     1 1 25 my ($self, $data) = @_;
133              
134 1 50       4 return unless defined $data;
135              
136 1 50       8 $self->_prepare() unless defined $self->{_a};
137 1         2 my $decrypt = '';
138 1         5 foreach (split //,$data) {
139 13 100       17 (_unsupported($_))
140             ?
141             ($decrypt .= $_)
142             :
143             ($decrypt .= $self->_decrypt($_));
144             }
145              
146 1         7 return $decrypt;
147             }
148              
149             #
150             #
151             # PRIVATE METHODS
152              
153             sub _prepare {
154 2     2   6 my ($self) = @_;
155              
156 2         7 my @data = ();
157 2         35 my ($i, $j) = (1, 1);
158 2         8 my ($a_, $z_, $l_, %_a, %_z, $_data);
159              
160 2 50 33     23 if (defined($self->{'source'}) && (-e $self->{'source'})) {
161 0         0 local undef $/;
162 0         0 open(my $IN, $self->{'source'});
163 0         0 $_data = <$IN>;
164 0         0 close($IN);
165              
166 0         0 chomp $_data;
167 0         0 @data = split /\,/,$_data;
168             }
169              
170 2 50       33 @data = ('a'..'z', 'A'..'Z') unless scalar(@data);
171 2         5 $l_ = scalar(@data);
172 2         6 foreach (@data) {
173 104         183 $a_->{$_} = $i++;
174 104         156 $z_->{$_} = ($l_ + 1) - $j++;
175             }
176 2 50       10 $self->{'r'} = $l_ if ($self->{'r'} > abs($l_));
177              
178 2         7 %_a = reverse %{$a_};
  2         82  
179 2         7 %_z = reverse %{$z_};
  2         63  
180              
181 2         8 $self->{'a_'} = $a_;
182 2         6 $self->{'z_'} = $z_;
183 2         7 $self->{'l_'} = $l_;
184 2         5 $self->{'_a'} = \%_a;
185 2         16 $self->{'_z'} = \%_z;
186             }
187              
188             sub _encrypt {
189 12     12   31 my ($self, $char) = @_;
190              
191 12         35 my $i = (($self->{'m'} * $self->{'a_'}->{$char}) + $self->{'r'}) % $self->{'l_'};
192 12 50       26 $i = $self->{'l_'} if ($i == 0);
193              
194             (defined($self->{'reverse'}) && ($self->{'reverse'}))
195             ?
196             return $self->{'_z'}->{$i}
197             :
198 12 50 33     98 return $self->{'_a'}->{$i};
199             }
200              
201             sub _decrypt {
202 12     12   22 my ($self, $char) = @_;
203              
204 12         14 my $i = 0;
205 12         13 my $j = 0;
206              
207             (defined($self->{'reverse'}) && ($self->{'reverse'}))
208             ?
209             ($i = $self->{'z_'}->{$char})
210             :
211 12 50 33     40 ($i = $self->{'a_'}->{$char});
212              
213 12         21 $j = (_multiplier($self->{'m'}, $self->{'l_'}) * ($i - $self->{'r'})) % $self->{'l_'};
214 12 50       18 $j = $self->{'l_'} if ($j == 0);
215              
216 12         25 return $self->{'_a'}->{$j};
217             }
218              
219             sub _unsupported {
220 26     26   48 my ($byte) = @_;
221              
222 26 100       71 return 1 if ($byte =~ /[\#\+\%\&\=\,\;\:\!\?\.\"\'\-\<\>\(\)\[\]\@\\\_\s]/);
223 24         93 return 0;
224             }
225              
226             sub _multiplier {
227 12     12   15 my ($a, $m) = @_;
228              
229 12         12 $m = abs($m);
230 12         12 $a = $a % $m;
231 12         17 my ($b, $x, $y, $n) = ($m, 1, 0);
232              
233 12         16 while ($a != 0) {
234 36         47 $n = int($b / $a);
235 36         67 ($a, $b, $x, $y) = ($b - $n * $a, $a, $y - $n * $x, $x);
236             }
237              
238 12         21 return $y % $m;
239             }
240              
241             =head1 AUTHOR
242              
243             Mohammad S Anwar, C<< >>
244              
245             =head1 REPOSITORY
246              
247             L
248              
249             =head1 BUGS
250              
251             Please report any bugs/feature requests to C or
252             through the web interface at L.
253             I will be notified & then you'll automatically be notified of progress on your bug
254             as I make changes.
255              
256             =head1 SUPPORT
257              
258             You can find documentation for this module with the perldoc command.
259              
260             perldoc Crypt::Affine
261              
262             You can also look for information at:
263              
264             =over 4
265              
266             =item * RT: CPAN's request tracker
267              
268             L
269              
270             =item * AnnoCPAN: Annotated CPAN documentation
271              
272             L
273              
274             =item * CPAN Ratings
275              
276             L
277              
278             =item * Search CPAN
279              
280             L
281              
282             =back
283              
284             =head1 LICENSE AND COPYRIGHT
285              
286             Copyright (C) 2011 - 2017 Mohammad S Anwar.
287              
288             This program is free software; you can redistribute it and/or modify it under
289             the terms of the the Artistic License (2.0). You may obtain a copy of the full
290             license at:
291              
292             L
293              
294             Any use, modification, and distribution of the Standard or Modified Versions is
295             governed by this Artistic License.By using, modifying or distributing the Package,
296             you accept this license. Do not use, modify, or distribute the Package, if you do
297             not accept this license.
298              
299             If your Modified Version has been derived from a Modified Version made by someone
300             other than you,you are nevertheless required to ensure that your Modified Version
301             complies with the requirements of this license.
302              
303             This license does not grant you the right to use any trademark, service mark,
304             tradename, or logo of the Copyright Holder.
305              
306             This license includes the non-exclusive, worldwide, free-of-charge patent license
307             to make, have made, use, offer to sell, sell, import and otherwise transfer the
308             Package with respect to any patent claims licensable by the Copyright Holder that
309             are necessarily infringed by the Package. If you institute patent litigation
310             (including a cross-claim or counterclaim) against any party alleging that the
311             Package constitutes direct or contributory patent infringement,then this Artistic
312             License to you shall terminate on the date that such litigation is filed.
313              
314             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
315             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
316             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
317             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
318             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
319             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
320             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
321              
322             =cut
323              
324             1; # End of Crypt::Affine