File Coverage

blib/lib/Crypt/Enigma.pm
Criterion Covered Total %
statement 9 335 2.6
branch 0 38 0.0
condition 0 39 0.0
subroutine 3 52 5.7
pod 11 11 100.0
total 23 475 4.8


line stmt bran cond sub pod time code
1             package Crypt::Enigma;
2              
3             $VERSION = '1.4';
4              
5 1     1   8637 use strict;
  1         3  
  1         2900  
6              
7             sub new {
8 0     0 1   my $class = shift;
9 0 0         my $args = ref($_[0]) ? shift : {@_};
10              
11             # Setup the object
12 0           my $self = {
13             _rotorObjects => undef,
14             _reflectorObject => undef,
15             _stecker => undef,
16             _settings => [],
17             _debug => 0,
18             };
19 0           bless $self, $class;
20              
21 0           $self->_init( $args );
22              
23 0           return( $self );
24             };
25              
26             sub _init {
27 0     0     my $self = shift;
28 0           my $args = shift;
29              
30 0           foreach( keys %{$args} ) {
  0            
31 0 0 0       if( ($_ =~ /^(rotors|startletters|ringsettings|stecker)$/) && (ref($args->{$_}) ne 'ARRAY') ) {
32 0           $self->_printDebug( "Argument '$_' should be an array reference (using defaults)" );
33 0           delete( ${$args}{$_} );
  0            
34             };
35             };
36              
37 0   0       my $rotors = $args->{rotors} || [ 'RotorI', 'RotorII', 'RotorIII' ];
38 0   0       my $startletters = $args->{startletters} || [ 'Z', 'A', 'A' ];
39 0   0       my $rings = $args->{ringsettings} || [ 0, 0, 0 ];
40 0   0       my $reflector = $args->{reflector} || 'ReflectorB';
41 0   0       my $stecker = $args->{stecker} || [];
42              
43 0 0         if( @{$rotors} < 3 ) {
  0            
44 0           $self->_printDebug( 'A minimum of 3 rotors must be defined (using defaults)' );
45 0           my @misc_rotors = ( 'RotorV', 'RotorVI', 'RotorVII' );
46 0           while( @{$rotors} < 3 ) {
  0            
47 0           push @{$rotors}, shift @misc_rotors;
  0            
48             };
49             };
50              
51 0           my $count = 0;
52 0           foreach( @{$rotors} ) {
  0            
53 0           push @{$self->{_settings}}, [ $_, $startletters->[$count], $rings->[$count] ];
  0            
54 0           $count++;
55             };
56              
57             # Create Reflector
58 0           $self->setReflector( $reflector );
59              
60             # Setup Steckerboard
61 0           $self->setSteckerBoard( $stecker );
62              
63 0           return( $self );
64             };
65              
66              
67             sub getRotorNames {
68 0     0 1   my $self = shift;
69 0           my @names;
70              
71 0           foreach( $self->_getRotorObjects ) {
72 0           push @names, $_->getName;
73             };
74              
75 0           return( @names );
76             };
77              
78             sub getStartLetters {
79 0     0 1   my $self = shift;
80 0           my @letters;
81              
82 0           foreach( $self->_getRotorObjects ) {
83 0           push @letters, $_->getStartLetter;
84             };
85 0           return( @letters );
86             };
87              
88             sub getRingSettings {
89 0     0 1   my $self = shift;
90 0           my @rings;
91 0           foreach( $self->_getRotorObjects ) {
92 0           push @rings, $_->getRingSetting;
93             };
94 0           return( @rings );
95             };
96              
97             sub getReflector {
98 0     0 1   my $self = shift;
99 0           return( $self->{_reflectorObject}->getName );
100             };
101              
102             sub setSteckerBoard {
103 0     0 1   my $self = shift;
104 0           my $stecker = shift;
105              
106 0 0         unless( (@{$stecker} % 2) == 0 ) {
  0            
107 0           $self->_printDebug( 'Odd number of letters in setSteckerBoard (disabling Steckerboard)' );
108 0           return;
109             };
110              
111 0           for(my $count = 0; $count < @{$stecker}; $count = $count+2 ) {
  0            
112 0           my $letter1 = uc( $stecker->[$count] );
113 0           my $letter2 = uc( $stecker->[$count+1] );
114 0           $self->{_stecker}->{$letter1} = $letter2;
115 0           $self->{_stecker}->{$letter2} = $letter1;
116             };
117              
118 0           return;
119             };
120              
121             sub dumpSettings {
122 0     0 1   my $self = shift;
123              
124 0           print STDERR "Rotors:\t\t". join( ' ', $self->getRotorNames ) ."\n";
125 0           print STDERR "Start:\t\t". join( ' ', $self->getStartLetters ) ."\n";
126 0           print STDERR "Rings:\t\t". join( ' ', $self->getRingSettings ) ."\n";
127 0           print STDERR "Reflector:\t". $self->getReflector ."\n";
128              
129 0           return;
130             };
131              
132             sub setRotor {
133 0     0 1   my $self = shift;
134 0           my $rotorName = shift;
135 0           my $startLetter = uc( shift );
136 0           my $ringSetting = shift;
137 0           my $rotorNumber = shift;
138              
139             # Do some checking
140 0 0 0       unless( defined($rotorName) && ($rotorName =~ /^Rotor(I|II|III|IV|V|VI|VII|VIII|Beta|Gamma)$/) ) {
141 0           $self->_printDebug( 'Invalid rotor name (using default \'RotorI\')' );
142 0           $rotorName = 'RotorI';
143             };
144              
145 0 0 0       unless( defined($startLetter) && $startLetter =~ /^[A-Z]$/ ) {
146 0           $self->_printDebug( "Invalid start letter (using default 'A' for $rotorName)" );
147 0           $startLetter = 'A';
148             };
149              
150 0 0 0       unless( defined($ringSetting) && ($ringSetting =~ /[0-9]$/) && ($ringSetting >= 0) && ($ringSetting <= 25) ) {
      0        
      0        
151 0           $self->_printDebug( "Invalid ring setting (using default '0' for $rotorName)" );
152 0           $ringSetting = 0;
153             }
154              
155 0 0 0       unless( defined($rotorNumber) && ($rotorNumber > 0) && ($rotorNumber < 6) ) {
      0        
156 0           $self->_printDebug( "Invalid rotor number (failed to add rotor $rotorName)" );
157 0           return( 0 );
158             };
159              
160 0           my $className = 'Crypt::Enigma::Rotors::'.$rotorName;
161 0           my $rotorObj = $className->new( $startLetter, $ringSetting );
162 0           $self->_storeRotorObject( $rotorObj, $rotorNumber-1 );
163              
164 0           return( 1 );
165             };
166              
167              
168             sub setReflector {
169 0     0 1   my $self = shift;
170 0           my $reflector = shift;
171              
172 0 0         unless( $reflector =~ /^Reflector(B|Bdunn|C|Cdunn)$/ ) {
173 0           $self->_printDebug( 'Invalid reflector name (using default \'ReflectorB\')' );
174 0           $reflector = 'ReflectorB';
175             };
176              
177 0           my $reflectorClass = 'Crypt::Enigma::Reflectors::' . $reflector;
178 0           my $reflectorObj = $reflectorClass->new;
179 0           $self->_storeReflectorObject( $reflectorObj );
180              
181 0           return( 1 );
182             };
183              
184              
185             sub cipher {
186 0     0 1   my $self = shift;
187 0           my $plainText = uc(shift);
188 0           my $cipherText = '';
189              
190             # setup the rotors
191 0           my $count = 1;
192 0           foreach( @{$self->{_settings}} ) {
  0            
193             # setRotor(rotorName, startLetter, ringSetting, rotorNumber)
194 0           $self->setRotor( $_->[0], , $_->[1], $_->[2], $count);
195 0           $count++;
196             };
197              
198 0           foreach my $letter ( split('', $plainText) ) {
199             # next if the text is not alpha
200 0 0         if( $letter !~ /[A-Z]/ ) {
201 0           next;
202             };
203              
204             # Stecker
205 0           $letter = $self->_performSteckerSwap( $letter );
206              
207             # fwd cycle
208 0           my $count = 0;
209 0           foreach( $self->_getRotorObjects ) {
210             # We always rotate the first scrambler
211 0 0         if( $count == 0 ) {
212 0           $_->_rotateDisk;
213             };
214 0           $letter = $_->fwdCipher( $letter );
215             # rotate the next disk, if the flag is set
216 0 0 0       if( $_->_getFlag('rotateNext') && ($count != 2) ) {
217 0           $self->_cycleNextRotor( $self->_getRotorObject($count+1) );
218 0           $_->_setFlag( rotateNext => 0 );
219             };
220 0           $count++;
221             };
222              
223             # reflector
224 0           $letter = $self->_reflect( $letter );
225              
226             # rev cycle
227 0           foreach( reverse($self->_getRotorObjects) ) {
228 0           $letter = $_->revCipher( $letter );
229             };
230              
231             # Stecker
232 0           $letter = $self->_performSteckerSwap( $letter );
233              
234 0           $cipherText .= $letter;
235             };
236              
237             # return uppercase ciphertext, like the original Enigma would do :)
238 0           return( uc($cipherText) );
239             };
240              
241              
242             sub _getRotorName {
243 0     0     my $self = shift;
244 0           my $rotor = shift;
245 0           return( $self->{settings}->{_rotorObjects}->[$rotor]->getName );
246             };
247              
248             sub _getStartLetter {
249 0     0     my $self = shift;
250 0           my $letter = shift;
251 0           return( $self->{settings}->{startletters}->[$letter] );
252             };
253              
254             sub _getRingSetting {
255 0     0     my $self = shift;
256 0           my $ring = shift;
257 0           return( $self->{settings}->{rings}->[$ring] );
258             };
259              
260             sub _storeRotorObject {
261 0     0     my $self = shift;
262 0           my $rotorObj = shift;
263 0           my $rotorNumber = shift;
264              
265 0 0         if( defined($rotorNumber) ) {
266 0           $self->{_rotorObjects}->[$rotorNumber] = $rotorObj;
267             }
268             else {
269 0           push @{$self->{_rotorObjects}}, $rotorObj;
  0            
270             };
271              
272 0           return( 1 );
273             };
274              
275             sub _getRotorObject {
276 0     0     my $self = shift;
277 0           my $rotor = shift;
278 0           return( $self->{_rotorObjects}->[$rotor] );
279             };
280              
281             sub _getRotorObjects {
282 0     0     my $self = shift;
283 0           return( @{$self->{_rotorObjects}} );
  0            
284             };
285              
286             sub _storeReflectorObject {
287 0     0     my $self = shift;
288 0           my $reflectorObj = shift;
289 0           $self->{_reflectorObject} = $reflectorObj;
290 0           return( 1 );
291             };
292              
293             sub _getReflectorObject {
294 0     0     my $self = shift;
295 0           return( $self->{_reflectorObject} );
296             };
297              
298              
299             # alter the input using the reflector
300             sub _reflect {
301 0     0     my $self = shift;
302 0           my $inputLetter = shift;
303              
304 0           my $outputLetter = $self->_getReflectorObject->_reflect( $inputLetter );
305              
306 0           return( $outputLetter );
307             };
308              
309             # alter the letter using the Steckerboard
310             sub _performSteckerSwap {
311 0     0     my $self = shift;
312 0           my $inputLetter = shift;
313              
314 0 0         if( defined($self->{_stecker}->{$inputLetter}) ) {
315 0           return( $self->{_stecker}->{$inputLetter} );
316             };
317              
318 0           return( $inputLetter );
319             };
320              
321             # Rotate the next rotor
322             sub _cycleNextRotor {
323 0     0     my $self = shift;
324 0           my $rotorObj = shift;
325 0           $rotorObj->_rotateDisk;
326              
327 0           return;
328             };
329              
330             sub _printDebug {
331 0     0     my $self = shift;
332 0           my $msg = shift;
333              
334 0 0         if( $self->{_debug} ) {
335 0           print $msg, "\n";
336             };
337              
338 0           return;
339             };
340              
341             sub setDebug {
342 0     0 1   my $self = shift;
343 0   0       my $debug = shift || 0;
344              
345 0           $self->{_debug} = $debug;
346              
347 0           return;
348             };
349              
350             package Crypt::Enigma::Reflectors;
351              
352 1     1   8 use strict;
  1         2  
  1         1638  
353              
354             sub _reflect {
355 0     0     my $self = shift;
356 0           my $inputLetter = shift;
357              
358 0           my $intInputLetter = ord($inputLetter) - 65;
359              
360 0           my $outputLetter = ${$self->{_alphabet}}[$intInputLetter];
  0            
361              
362 0           return( $outputLetter );
363             };
364              
365             sub getName {
366 0     0     my $self = shift;
367 0           return( $self->{_label} );
368             };
369              
370              
371             package Crypt::Enigma::Reflectors::ReflectorB;
372              
373             @Crypt::Enigma::Reflectors::ReflectorB::ISA = qw(Crypt::Enigma::Reflectors);
374              
375             sub new {
376 0     0     my $class = shift;
377              
378 0           my $self = {
379             '_label' => 'ReflectorB',
380             '_alphabet' => [
381             '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'
382             ],
383             };
384 0           bless $self, $class;
385              
386 0           return( $self );
387             };
388              
389              
390             package Crypt::Enigma::Reflectors::ReflectorBdunn;
391              
392              
393             @Crypt::Enigma::Reflectors::ReflectorBdunn::ISA = qw(Crypt::Enigma::Reflectors);
394              
395             sub new {
396 0     0     my $class = shift;
397              
398 0           my $self = {
399             '_label' => 'ReflectorBdunn',
400             '_alphabet' => [
401             'E', 'N', 'K', 'Q', 'A', 'U', 'Y', 'W', 'J', 'I', 'C', 'O', 'P', 'B', 'L', 'M', 'D', 'X', 'Z', 'V', 'F', 'T', 'H', 'R', 'G', 'S'
402             ],
403             };
404 0           bless $self, $class;
405              
406 0           return( $self );
407             };
408              
409              
410             package Crypt::Enigma::Reflectors::ReflectorC;
411              
412             @Crypt::Enigma::Reflectors::ReflectorC::ISA = qw(Crypt::Enigma::Reflectors);
413              
414             sub new {
415 0     0     my $class = shift;
416              
417 0           my $self = {
418             '_label' => 'ReflectorC',
419             '_alphabet' => [
420             'F', 'N', 'P', 'J', 'I', 'A', 'O', 'Y', 'E', 'D', 'R', 'Z', 'X', 'W', 'G', 'C', 'T', 'K', 'U', 'Q', 'S', 'B', 'N', 'M', 'H', 'L'
421             ],
422             };
423 0           bless $self, $class;
424              
425 0           return( $self );
426             };
427              
428              
429             package Crypt::Enigma::Reflectors::ReflectorCdunn;
430              
431             @Crypt::Enigma::Reflectors::ReflectorCdunn::ISA = qw(Crypt::Enigma::Reflectors);
432              
433             sub new {
434 0     0     my $class = shift;
435              
436 0           my $self = {
437             '_label' => 'ReflectorCdunn',
438             '_alphabet' => [
439             'R', 'D', 'O', 'B', 'J', 'N', 'T', 'K', 'V', 'E', 'H', 'M', 'L', 'F', 'C', 'W', 'Z', 'A', 'X', 'G', 'Y', 'I', 'P', 'S', 'U', 'Q'
440             ],
441             };
442 0           bless $self, $class;
443              
444 0           return( $self );
445             };
446              
447              
448             package Crypt::Enigma::Rotors;
449              
450 1     1   8 use strict;
  1         101  
  1         2898  
451              
452             sub _init {
453 0     0     my $self = shift;
454 0           my $startLetter = shift;
455              
456 0           my $intStartLetter = ord($startLetter) - 65;
457              
458 0           for( my $count = 0; $count < $intStartLetter; $count++ ) {
459             # rotate the letters
460 0           my $letter = pop @{$self->{_alphabet}};
  0            
461 0           unshift @{$self->{_alphabet}}, $letter;
  0            
462 0 0         $self->{_cycleLetterPosition} == 0 ? $self->{_cycleLetterPosition} = 25 : $self->{_cycleLetterPosition}--;
463             };
464              
465 0           return( 0 );
466             };
467              
468             sub getName {
469 0     0     my $self = shift;
470 0           return( $self->{_label} );
471             };
472              
473             sub getStartLetter {
474 0     0     my $self = shift;
475 0           return( $self->{_startLetter} );
476             };
477              
478             sub getRingSetting {
479 0     0     my $self = shift;
480 0           return( $self->{_ringSetting} );
481             };
482              
483             sub fwdCipher {
484 0     0     my $self = shift;
485 0           my $inputLetter = shift;
486              
487 0           my $intInputLetter = ( ord($inputLetter) - 65 + $self->{_ringSetting} ) % 26;
488 0           my $outputLetter = ${$self->{_alphabet}}[$intInputLetter];
  0            
489              
490 0           return( $outputLetter );
491             };
492              
493              
494             sub revCipher {
495 0     0     my $self = shift;
496 0           my $inputLetter = shift;
497 0           my $outputLetter;
498              
499 0           my $count = 0;
500 0           foreach ( @{$self->{_alphabet}} ) {
  0            
501 0 0         if( $inputLetter eq $_ ) {
502 0           $outputLetter = chr((($count - $self->{_ringSetting} + 26) % 26) + 65);
503             };
504 0           $count++;
505             };
506 0           return( $outputLetter );
507             };
508              
509              
510             # rotate the polyalphabetic substitution by 1 letter
511             sub _rotateDisk {
512 0     0     my $self = shift;
513              
514 0           my $letter = pop @{$self->{_alphabet}};
  0            
515 0           unshift @{$self->{_alphabet}}, $letter;
  0            
516              
517 0 0         if( $self->{_cycleLetterPosition} == 0 ) {
518 0           $self->_setFlag( rotateNext => 1 );
519 0           $self->{_cycleLetterPosition} = 25;
520             }
521             else {
522 0           $self->{_cycleLetterPosition}--;
523             };
524              
525 0           return( 0 );
526             };
527              
528              
529             sub _setFlag {
530 0     0     my $self = shift;
531 0           my $flag = shift;
532 0           my $bool = shift;
533              
534 0           $self->{flags}->{$flag} = $bool;
535              
536 0           return( 1 );
537             };
538              
539             sub _getFlag {
540 0     0     my $self = shift;
541 0           my $flag = shift;
542              
543 0 0         if( defined($self->{flags}->{$flag}) ) {
544 0           return( $self->{flags}->{$flag} );
545             };
546              
547 0           return( 0 );
548             };
549              
550              
551             package Crypt::Enigma::Rotors::RotorI;
552              
553             @Crypt::Enigma::Rotors::RotorI::ISA = qw(Crypt::Enigma::Rotors);
554              
555             sub new {
556 0     0     my $class = shift;
557 0           my $startLetter = shift;
558 0           my $ringSetting = shift;
559              
560 0           my $self = {
561             '_label' => 'RotorI',
562             '_cycleLetterPosition' => (16 + $ringSetting) % 25,
563             '_ringSetting' => $ringSetting,
564             '_startLetter' => $startLetter,
565             '_alphabet' => [
566             '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'
567             ]
568             };
569 0           bless $self, $class;
570              
571 0           $self->_init( $startLetter );
572              
573 0           return( $self );
574             };
575              
576              
577             package Crypt::Enigma::Rotors::RotorII;
578              
579             @Crypt::Enigma::Rotors::RotorII::ISA = qw(Crypt::Enigma::Rotors);
580              
581             sub new {
582 0     0     my $class = shift;
583 0           my $startLetter = shift;
584 0           my $ringSetting = shift;
585              
586 0           my $self = {
587             '_label' => 'RotorII',
588             '_cycleLetterPosition' => (5 + $ringSetting) % 25,
589             '_ringSetting' => $ringSetting,
590             '_startLetter' => $startLetter,
591             '_alphabet' => [
592             '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'
593             ]
594             };
595 0           bless $self, $class;
596              
597 0           $self->_init( $startLetter );
598              
599 0           return( $self );
600             };
601              
602              
603             package Crypt::Enigma::Rotors::RotorIII;
604              
605             @Crypt::Enigma::Rotors::RotorIII::ISA = qw(Crypt::Enigma::Rotors);
606              
607             sub new {
608 0     0     my $class = shift;
609 0           my $startLetter = shift;
610 0           my $ringSetting = shift;
611              
612 0           my $self = {
613             '_label' => 'RotorIII',
614             '_cycleLetterPosition' => (22 + $ringSetting) % 25,
615             '_ringSetting' => $ringSetting,
616             '_startLetter' => $startLetter,
617             '_alphabet' => [
618             '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'
619             ]
620             };
621 0           bless $self, $class;
622              
623 0           $self->_init( $startLetter );
624              
625 0           return( $self );
626             };
627              
628              
629             package Crypt::Enigma::Rotors::RotorIV;
630              
631             @Crypt::Enigma::Rotors::RotorIV::ISA = qw(Crypt::Enigma::Rotors);
632              
633              
634             sub new {
635 0     0     my $class = shift;
636 0           my $startLetter = shift;
637 0           my $ringSetting = shift;
638              
639 0           my $self = {
640             '_label' => 'RotorIV',
641             '_cycleLetterPosition' => (10 + $ringSetting) % 25,
642             '_ringSetting' => $ringSetting,
643             '_startLetter' => $startLetter,
644             '_alphabet' => [
645             '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'
646             ]
647             };
648 0           bless $self, $class;
649              
650 0           $self->_init( $startLetter );
651              
652 0           return( $self );
653             };
654              
655              
656             package Crypt::Enigma::Rotors::RotorV;
657              
658             @Crypt::Enigma::Rotors::RotorV::ISA = qw(Crypt::Enigma::Rotors);
659              
660              
661             sub new {
662 0     0     my $class = shift;
663 0           my $startLetter = shift;
664 0           my $ringSetting = shift;
665              
666 0           my $self = {
667             '_label' => 'RotorV',
668             '_cycleLetterPosition' => (0 + $ringSetting) % 25,
669             '_ringSetting' => $ringSetting,
670             '_startLetter' => $startLetter,
671             '_alphabet' => [
672             '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'
673             ]
674             };
675 0           bless $self, $class;
676              
677 0           $self->_init( $startLetter );
678              
679 0           return( $self );
680             };
681              
682              
683              
684             package Crypt::Enigma::Rotors::RotorVI;
685              
686             @Crypt::Enigma::Rotors::RotorVI::ISA = qw(Crypt::Enigma::Rotors);
687              
688              
689             sub new {
690 0     0     my $class = shift;
691 0           my $startLetter = shift;
692 0           my $ringSetting = shift;
693              
694 0           my $self = {
695             '_label' => 'RotorVI',
696             '_cycleLetterPosition' => (13 + $ringSetting) % 25,
697             '_ringSetting' => $ringSetting,
698             '_startLetter' => $startLetter,
699             '_alphabet' => [
700             'J', 'P', 'G', 'V', 'O', 'U', 'M', 'F', 'Y', 'Q', 'B', 'E', 'N', 'H', 'Z', 'R', 'D', 'K', 'A', 'S', 'X', 'L', 'I', 'C', 'T', 'W'
701             ]
702             };
703 0           bless $self, $class;
704              
705 0           $self->_init( $startLetter );
706              
707 0           return( $self );
708             };
709              
710              
711              
712             package Crypt::Enigma::Rotors::RotorVII;
713              
714             @Crypt::Enigma::Rotors::RotorVII::ISA = qw(Crypt::Enigma::Rotors);
715              
716              
717             sub new {
718 0     0     my $class = shift;
719 0           my $startLetter = shift;
720 0           my $ringSetting = shift;
721              
722 0           my $self = {
723             '_label' => 'RotorVII',
724             '_cycleLetterPosition' => (13 + $ringSetting) % 25,
725             '_ringSetting' => $ringSetting,
726             '_startLetter' => $startLetter,
727             '_alphabet' => [
728             'N', 'Z', 'J', 'H', 'G', 'R', 'C', 'X', 'M', 'Y', 'S', 'W', 'B', 'O', 'U', 'F', 'A', 'I', 'V', 'L', 'P', 'E', 'K', 'Q', 'D', 'T'
729             ]
730             };
731 0           bless $self, $class;
732              
733 0           $self->_init( $startLetter );
734              
735 0           return( $self );
736             };
737              
738              
739              
740             package Crypt::Enigma::Rotors::RotorVIII;
741              
742             @Crypt::Enigma::Rotors::RotorVIII::ISA = qw(Crypt::Enigma::Rotors);
743              
744              
745             sub new {
746 0     0     my $class = shift;
747 0           my $startLetter = shift;
748 0           my $ringSetting = shift;
749              
750 0           my $self = {
751             '_label' => 'RotorVIII',
752             '_cycleLetterPosition' => (13 + $ringSetting) % 25,
753             '_ringSetting' => $ringSetting,
754             '_startLetter' => $startLetter,
755             '_alphabet' => [
756             'F', 'K', 'Q', 'H', 'T', 'L', 'X', 'O', 'C', 'B', 'J', 'S', 'P', 'D', 'Z', 'R', 'A', 'M', 'E', 'W', 'N', 'I', 'U', 'Y', 'G', 'V'
757             ]
758             };
759 0           bless $self, $class;
760              
761 0           $self->_init( $startLetter );
762              
763 0           return( $self );
764             };
765              
766              
767              
768             package Crypt::Enigma::Rotors::RotorBeta;
769              
770             @Crypt::Enigma::Rotors::RotorBeta::ISA = qw(Crypt::Enigma::Rotors);
771              
772              
773             sub new {
774 0     0     my $class = shift;
775 0           my $startLetter = shift;
776 0           my $ringSetting = shift;
777              
778 0           my $self = {
779             '_label' => 'RotorBeta',
780             '_cycleLetterPosition' => (13 + $ringSetting) % 25,
781             '_ringSetting' => $ringSetting,
782             '_startLetter' => $startLetter,
783             '_alphabet' => [
784             'L', 'E', 'Y', 'J', 'V', 'C', 'N', 'I', 'X', 'W', 'P', 'B', 'Q', 'M', 'D', 'R', 'T', 'A', 'K', 'Z', 'G', 'F', 'U', 'H', 'O', 'S'
785             ]
786             };
787 0           bless $self, $class;
788              
789 0           $self->_init( $startLetter );
790              
791 0           return( $self );
792             };
793              
794              
795              
796             package Crypt::Enigma::Rotors::RotorGamma;
797              
798             @Crypt::Enigma::Rotors::RotorGamma::ISA = qw(Crypt::Enigma::Rotors);
799              
800              
801             sub new {
802 0     0     my $class = shift;
803 0           my $startLetter = shift;
804 0           my $ringSetting = shift;
805              
806 0           my $self = {
807             '_label' => 'RotorGamma',
808             '_cycleLetterPosition' => (13 + $ringSetting) % 25,
809             '_ringSetting' => $ringSetting,
810             '_startLetter' => $startLetter,
811             '_alphabet' => [
812             'F', 'S', 'O', 'K', 'A', 'N', 'U', 'E', 'R', 'H', 'M', 'B', 'T', 'I', 'Y', 'C', 'W', 'L', 'Q', 'P', 'Z', 'X', 'V', 'G', 'J', 'D'
813             ]
814             };
815 0           bless $self, $class;
816              
817 0           $self->_init( $startLetter );
818              
819 0           return( $self );
820             };
821              
822              
823              
824             1;
825              
826              
827             =pod
828              
829             =head1 TITLE
830              
831             Crypt::Enigma - Perl implementation of the Enigma cipher
832              
833              
834             =head1 DESCRIPTION
835              
836             This module is a complete working Perl implementation of the Enigma Machine used during World War II. The cipher calculations are based on actual Enigma values and the resulting ciphered values are as would be expected from an Enigma Machine.
837              
838             The implementation allows for all of the Rotors and Reflectors available to the real world Enigma to be used. A Steckerboard has also been implemented, allowing letter substitutions to be made.
839              
840             The list of available rotors is as follows:
841              
842             RotorI, RotorII, RotorIII, RotorIV, RotorV, RotorVI, RotorVII, RotorVIII, RotorBeta, RotorGamma.
843              
844             The list of available reflectors is as follows:
845              
846             ReflectorB, ReflectorBdunn, ReflectorC, ReflectorCdunn.
847              
848             As with the real world Enigma, a minimum of 3 and a maximum of 5 rotors along with 1 reflector may be defined for each encryption/decryption.
849              
850              
851             =head1 SYNOPSIS
852              
853             use Crypt::Enigma;
854              
855             my $args = {
856             rotors => [ 'RotorI', 'RotorII', 'RotorIII' ],
857             startletters => [ 'A', 'B', 'C' ],
858             ringsettings => [ '0', '5', '10' ],
859             reflector => 'ReflectorB',
860             };
861              
862             $enigma = Crypt::Enigma->new( $args );
863              
864             # Change rotor settings
865             $enigma->setRotor( 'RotorVI', 'Z', '3', 1 );
866              
867             # Set the letter substitutions
868             $enigma->setSteckerBoard( [ 'G', 'C' ] );
869              
870             # Encode the plaintext
871             $cipher_text = $enigma->cipher( $plain_text );
872              
873             # Decode the ciphertext
874             $plain_text = $enigma->cipher( $cipher_text );
875              
876              
877             =head1 CLASS INTERFACE
878              
879             =head2 CONSTRUCTORS
880              
881             A C object is created by calling the new constructor either with, or without arguments. If the constructor is called without arguments the defaults values will be used (unless these are set using the C method detailed below).
882              
883             =over 4
884              
885             =item new ( ARGS )
886              
887             The arguments which can be used to create a C instance are as follows:
888              
889             -rotors
890             -startletters
891             -ringsettings
892             -stecker
893             -reflector
894              
895             The first four are to be passed in as references to arrays, while the last argument is a scalar.
896              
897             =back
898              
899             =head2 OBJECT METHODS
900              
901             =over 4
902              
903             =item cipher ( ARGS )
904              
905             This method crypts and decrypts the supplied argument containing a string of text. Any characters which are not from the English alphabet (punctuation, numerics, etc) are ignored.
906              
907             =item setRotor ( ARGS )
908              
909             The C method is called to set a rotor of the Enigma to specific settings. The arguments to be passed in are as follows:
910              
911             -rotor name (eg. RotorI, RotorII, etc)
912             -initial start letter (eg. 'A', 'B', etc)
913             -ring setting (eg. '0', '1', etc)
914             -rotor number (eg. '1', '2', etc)
915              
916             If incorrect values are passed in, the default settings are used.
917              
918             =item setReflector ( ARG )
919              
920             The C method is called to set the reflector of the Enigma Machine. The argument to be passed in is a string containing the name of any of the available reflectors.
921              
922             =item setSteckerBoard ( ARGS )
923              
924             The Steckerboard is set by calling the C method and supplying a reference to an array as the first argument.
925              
926             The array should contain a set of letter pairs, such as:
927              
928             [ 'A', 'B', 'C', 'D' ];
929              
930             In this example, each instance of the letter 'A' will be replaced with the letter 'B' (and vice-versa) and each instance of the letter 'C' will be replaced with the letter 'D' (and vice-versa).
931              
932             =item getRotorNames
933              
934             Returns an array containing the rotor names currently defined for encryption/decryption.
935              
936             =item getStartLetters
937              
938             Returns an array containing the start letters currently defined for encryption/decryption.
939              
940             =item getRingSettings
941              
942             Returns an array containing the ring settings currently defined for encryption/decryption.
943              
944             =item getReflector
945              
946             Returns a string containing the name of the reflector currently defined for encryption/decryption.
947              
948             =item dumpSettings
949              
950             This method will print out (to STDERR) the current rotor settings.
951              
952             =item setDebug ( ARG )
953              
954             The C method is used to set the debug value of the C object. The value of the argument can be either 1 (debug on) or 0 (debug off). The debug value is set to 0 by default.
955              
956             =back
957              
958             =head1 KNOWN BUGS
959              
960             None, but that does not mean there are not any.
961              
962             =head1 AUTHOR
963              
964             Alistair Francis,
965              
966             =cut