File Coverage

blib/lib/Crypt/Enigma.pm
Criterion Covered Total %
statement 12 120 10.0
branch 0 8 0.0
condition n/a
subroutine 4 13 30.7
pod 0 9 0.0
total 16 150 10.6


line stmt bran cond sub pod time code
1             package Crypt::Enigma;
2              
3 1     1   6645 use 5.006;
  1         4  
  1         53  
4 1     1   6 use strict;
  1         3  
  1         47  
5 1     1   6 no strict 'refs';
  1         6  
  1         43  
6 1     1   7 use warnings;
  1         1  
  1         2104  
7              
8             require Exporter;
9              
10             our @ISA = qw(Exporter);
11              
12             # Items to export into callers namespace by default. Note: do not export
13             # names by default without a very good reason. Use EXPORT_OK instead.
14             # Do not simply export all your public functions/methods/constants.
15              
16             # This allows declaration use Crypt::Enigma ':all';
17             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
18             # will save memory.
19             our %EXPORT_TAGS = ( 'all' => [ qw(
20            
21             ) ] );
22              
23             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
24              
25             our @EXPORT = qw(
26            
27             );
28             our $VERSION = '1.1';
29              
30              
31             # Preloaded methods go here.
32              
33             # Enigma.pm by Jason Blakey
34             # jblakey@frogboy.net
35              
36              
37             #
38             # DEFINITIONS
39             #
40              
41             # Define our rotors, where the notches are on each rotor, and the
42             # reflector.
43             our (@ROTOR0) = qw (e k m f l g d q v z n t o w y h x u s p a i b r c j);
44             our (@ROTOR1) = qw (a j d k s i r u x b l h w t m c q g z n p y f v o e);
45             our (@ROTOR2) = qw (b d f h j l c p r t x v z n y e i w g a k m u s q o);
46             our (@ROTOR3) = qw (e s o v p z j a y q u i r h x l n f t g k d c m w b);
47             our (@ROTOR4) = qw (v z b r g i t y u p s d n h l x a w m j q o f e c k);
48              
49             # To quiet the -w warnings...
50             if (@ROTOR0 and @ROTOR1 and @ROTOR2 and @ROTOR3 and @ROTOR4) {};
51              
52             our (@NOTCHES) = qw (7 25 11 7 2);
53              
54             our (@REFLECTOR) = qw (y r u h q s l d p x n g o k m i e b f z c w v j a t);
55              
56             #
57             # SUBROUTINES
58             #
59              
60             sub new {
61 0     0 0   my ($class) = $_[0];
62             # Create a new anonymous hash...
63 0           my ($self) = {};
64              
65             # Make it an object...
66 0           bless ($self, $class);
67              
68             # And return the created object...
69 0           return ($self);
70             }
71              
72             sub setup {
73 0     0 0   my ($self) = $_[0];
74 0           my ($rotors) = $_[1];
75 0           my ($ring_settings) = $_[2];
76 0           my ($initial_settings) = $_[3];
77              
78             # Reverse the input so that they make sense...
79 0           my (@rotors) = reverse (split (//, $rotors));
80 0           my (@ring_settings) = reverse (split (//, $ring_settings));
81 0           my (@initial_settings) = reverse (split (//, $initial_settings));
82              
83 0           our (%NOTCHES);
84              
85             #
86             # So first, we need to put the rotors inside the
87             # enigma in the correct order and combination.
88             #
89              
90 0           my ($rotor);
91 0           foreach $rotor (0 .. $#rotors) {
92             # Initialize the number of clicks on each rotor...
93 0           $self->{ROTORS}->{$rotor}->{CLICKS} = 0;
94              
95             # Store the notch position for this rotor.
96 0           $self->{ROTORS}->{$rotor}->{NOTCH} = $NOTCHES[$rotor];
97              
98             # Store the ring setting for this rotor.
99 0           my ($ring_setting) = chr2num ($ring_settings[$rotor]);
100 0           $self->{ROTORS}->{$rotor}->{RING_SETTING} = $ring_setting;
101              
102             # Determine the variable name for this rotor
103 0           my ($rotorname) = "ROTOR".($rotors[$rotor] - 1);
104              
105 0           my ($input);
106 0           foreach $input (0 .. $#{$rotorname}) {
  0            
107              
108 0           my ($output) = ${$rotorname}[$input];
  0            
109 0           $output = chr2num ($output);
110              
111 0           my ($new_input) = ($input + $ring_setting) % 26;
112 0           my ($new_output) = ($output - $ring_setting) % 26;
113              
114 0           $self->{ROTORS}->{$rotor}->{FORWARD}->{$new_input} =
115             $new_output;
116 0           $self->{ROTORS}->{$rotor}->{REVERSE}->{$new_output} =
117             $new_input;
118             }
119              
120             #
121             # And advance each rotor until it is in the requested
122             # initial position.
123             #
124              
125 0           my ($initial_setting) = $initial_settings[$rotor];
126 0           my ($required_turns) =
127             (chr2num ($initial_setting) - $ring_setting) % 26;
128              
129 0           while ($required_turns > 0) {
130 0           $self->roll_rotor ($rotor);
131 0           $required_turns--;
132             }
133             }
134              
135             # And return...
136 0           return ();
137             }
138              
139             sub stekker {
140 0     0 0   my ($self) = $_[0];
141 0           my ($input_chr) = $_[1];
142 0           my ($output_chr) = $_[2];
143              
144 0           my ($input_num) = chr2num ($input_chr);
145 0           my ($output_num) = chr2num ($output_chr);
146              
147             # Store the stekker'ed positions...
148 0           $self->{STEKKER}->{$input_num} = $output_num;
149 0           $self->{STEKKER}->{$output_num} = $input_num;
150             }
151              
152             sub input {
153 0     0 0   my ($self) = $_[0];
154 0           my ($input_chr) = $_[1];
155              
156 0           our (%REFLECTOR);
157              
158             # First, we convert the letter to a number
159 0           my ($input_num) = chr2num($input_chr);
160              
161             # Next, we go through the stekkerboard.
162             # If the input character was stekker'ed...
163 0 0         if (defined ($self->{STEKKER}->{$input_num})) {
164 0           $input_num = $self->{STEKKER}->{$input_num};
165             }
166              
167             # Next, we need to move the rotors forward by 1 click...
168 0           $self->advance_rotors ();
169              
170             # Next, we go through the rotors forward.
171 0           my ($rotor);
172 0           foreach $rotor (sort (keys (%{$self->{ROTORS}}))) {
  0            
173 0           $input_num =
174             $self->{ROTORS}->{$rotor}->{FORWARD}->{$input_num};
175             }
176              
177             # Now, we go through the reflector.
178 0           $input_chr = $REFLECTOR[$input_num];
179 0           $input_num = chr2num ($input_chr);
180              
181             # Next, we go back through the rotors in REVERSE.
182 0           foreach $rotor (reverse (sort (keys (%{$self->{ROTORS}})))) {
  0            
183 0           $input_num =
184             $self->{ROTORS}->{$rotor}->{REVERSE}->{$input_num};
185             }
186              
187             # Next, back through the Stekker.
188 0 0         if (defined ($self->{STEKKER}->{$input_num})) {
189 0           $input_num = $self->{STEKKER}->{$input_num};
190             }
191              
192             # Convert the number back into a character.
193 0           my ($output_char) = num2chr($input_num);
194              
195             # And finally return the result.
196 0           return ($output_char);
197             }
198              
199             sub advance_rotors {
200 0     0 0   my ($self) = $_[0];
201              
202             # The first rotor always gets moved one click forward, so
203             # default to a positive advance_check.
204 0           my ($we_should_advance) = 1;
205              
206             # Step through each rotor...
207 0           my ($rotor);
208 0           foreach $rotor (sort (keys (%{$self->{ROTORS}}))) {
  0            
209              
210             # If we should advance this rotor...
211 0 0         if ($we_should_advance) {
212              
213             # Now, we need to rotate the rotors values...
214 0           $self->roll_rotor ($rotor);
215              
216             # If the new notch position is not 0, then
217             # we leave advance_rotor set so that we will
218             # advance the next rotor...
219              
220 0           my ($notch_position) =
221             $self->{ROTORS}->{$rotor}->{NOTCH};
222              
223 0 0         if ($notch_position != 0 ) {
224 0           $we_should_advance = 0;
225             }
226             }
227             }
228              
229             # And return.
230 0           return ();
231             }
232              
233             sub roll_rotor {
234 0     0 0   my ($self) = $_[0];
235 0           my ($rotor) = $_[1];
236              
237 0           my (%temp);
238              
239             #
240             # Step through each transformation this rotor holds.
241             #
242              
243             my ($position);
244 0           foreach $position (keys (%{$self->{ROTORS}->{$rotor}->{FORWARD}})) {
  0            
245              
246             # move the position up one...
247 0           my ($new_position) = ($position + 1) % 26;
248              
249             # And move the value for that position down one...
250 0           my ($value) =
251             $self->{ROTORS}->{$rotor}->{FORWARD}->{$position};
252 0           my ($new_value) = ($value - 1) % 26;
253              
254             # Store the transformation in a temporary hash...
255 0           $temp{$rotor}->{FORWARD}->{$new_position} = $new_value;
256             }
257              
258             # Now, copy the temprotors over into rotors...
259 0           foreach $position (sort (keys (%{$temp{$rotor}->{FORWARD}}))) {
  0            
260 0           my ($value) = $temp{$rotor}->{FORWARD}->{$position};
261 0           $self->{ROTORS}->{$rotor}->{FORWARD}->{$position} = $value;
262 0           $self->{ROTORS}->{$rotor}->{REVERSE}->{$value}= $position;
263             }
264              
265             # Next, we compute the new notch position for this rotor we just
266             # clicked.
267              
268 0           my ($current_notch) = $self->{ROTORS}->{$rotor}->{NOTCH};
269              
270 0           my ($new_notch) = ($current_notch - 1) % 26;
271 0           $self->{ROTORS}->{$rotor}->{NOTCH} = $new_notch;
272              
273             # Update the number of clicks for this rotor.
274 0           my ($clicks) = $self->{ROTORS}->{$rotor}->{CLICKS};
275 0           $self->{ROTORS}->{$rotor}->{CLICKS} = $clicks + 1;
276              
277             # And return...
278 0           return ();
279             }
280              
281             sub view {
282 0     0 0   my ($self) = $_[0];
283              
284 0           my ($view) = "";
285              
286 0           my ($rotor);
287 0           foreach $rotor (reverse (sort (keys (%{$self->{ROTORS}})))) {
  0            
288              
289 0           my ($clicks) = $self->{ROTORS}->{$rotor}->{CLICKS};
290 0           my ($ring_setting) = $self->{ROTORS}->{$rotor}->{RING_SETTING};
291              
292 0           my ($num) = ($clicks + $ring_setting) % 26;
293 0           my ($chr) = num2chr ($num);
294 0           $view .= "$chr";
295             }
296 0           return ($view);
297             }
298              
299             # A couple of number -> letter, letter -> number routines...
300             sub chr2num {
301 0     0 0   my ($character) = $_[0];
302 0           return (ord ($character) - 97);
303             }
304              
305             sub num2chr {
306 0     0 0   my ($number) = $_[0];
307 0           return (chr($number + 97));
308             }
309              
310             return (1);
311             __END__