File Coverage

blib/lib/Crypt/OOEnigma/Military.pm
Criterion Covered Total %
statement 66 71 92.9
branch 9 16 56.2
condition 1 3 33.3
subroutine 9 9 100.0
pod 0 3 0.0
total 85 102 83.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # Military.pm
4             #
5             # Copyright (c) 2002 Ambriel Consulting
6             # sjb Mon Mar 18 20:55:53 GMT 2002
7             #
8              
9             package Crypt::OOEnigma::Military ;
10             $VERSION="0.3";
11             =head1 NAME
12              
13             Crypt::OOEnigma::Military - A military Enigma machine circa 1940. It
14             differs from the Commercial Enigma in the addition of a plugboard before
15             the rotors.
16              
17             =head1 SYNOPSIS
18              
19             use Crypt::OOEnigma::Military;
20             # An Enigma with 3 default Rotors (with identity substitutions)
21             my $enigma = new Crypt::OOEnigma::Military;
22              
23             # OR
24             use Crypt::OOEnigma::Military;
25             use Crypt::OOEnigma::Rotor;
26             my @rotors = ()
27             # Populate the list of Crypt::OOEnigma::Rotor
28             Crypt::OOEnigma::Military->new( rotors => [@rotors] );
29              
30             # OR EVEN
31              
32             use Crypt::OOEnigma::Military;
33             use Crypt::OOEnigma::Rotor;
34             use Crypt::OOEnigma::Reflector;
35             use Crypt::OOEnigma::Plugboard;
36             my @rotors = ()
37             # Populate the list of Crypt::OOEnigma::Rotor, see relevant pod
38             my $reflector = new Crypt:OOEnigma::Reflector(params); # see relevant pod
39             my $plugboard = new Crypt:OOEnigma::Plugboard(params); # see relevant pod
40             Crypt::OOEnigma::Military->new( rotors => [@rotors],
41             plugboard => $plugboard,
42             reflector => $reflector);
43              
44             my $cipher = $enigma->encipher($mesg);
45             my $decode = $enigma->encipher($cipher); # self-inverse
46              
47             # for internal use
48              
49             $enigma->init(); # returns the rotors to their initial state
50              
51             =head1 DESCRIPTION
52              
53             This module provides a Military Enigma machine which differs in that a
54             Plugboard is added before the Rotors.
55              
56             You should usually create a Military Enigma with your own Plugboard,
57             Rotors and Reflector.
58              
59             =head1 NOTES
60              
61             None
62              
63             =head1 BUGS and CAVEATS
64              
65             =head2 Enigma is weak!
66              
67             Cryptographers talk of the strength of a cryptographic algorithm in term of
68             whether it is computationally feasible to break it. It is, of course,
69             computationally feasible to break an Enigma cipher so don't use it for
70             anything serious!
71              
72             =head1 HISTORY
73              
74             This package was created in spring 2002 as an exercise in OO Perl and
75             preparing modules properly for CPAN. More importantly, the Enigma is
76             interesting.
77              
78             CPAN already has a Crypt::Enigma which is not object oriented and implements
79             only one Enigma (whereas you can create any Enigma-like machine with these
80             objects). Hence the package name Crypt::OOEnigma
81              
82             =head1 SEE ALSO
83              
84             The Pleasures of Counting, T W Korner, CUP 1996. A great book for anyone with
85             the slightest interest in mathematics
86             ISBN 0 521 56087 X hardback
87             ISBN 0 521 56823 4 paperback
88              
89             Crypt::OOEnigma::Military
90              
91             The components:
92             Crypt::OOEnigma::Rotor
93             Crypt::OOEnigma::Reflector
94             Crypt::OOEnigma::Plugboard
95              
96             =head1 AUTHOR
97              
98             S J Baker, Ambriel Consulting, http://ambrielconsulting.com
99              
100             =head1 COPYRIGHT
101              
102             This package is licenced under the same terms as Perl itself.
103              
104             =cut
105 2     2   62809 use Carp ;
  2         4  
  2         196  
106 2     2   3202 use Crypt::OOEnigma::Rotor ;
  2         5  
  2         58  
107 2     2   1068 use Crypt::OOEnigma::Reflector ;
  2         3  
  2         47  
108 2     2   1194 use Crypt::OOEnigma::Plugboard ;
  2         4  
  2         60  
109              
110              
111             # use Autoloading for accessors
112 2     2   9 use subs qw( rotors reflector plugboard );
  2         3  
  2         8  
113              
114             my %fields = (
115             rotors => undef,
116             reflector => undef,
117             plugboard => undef
118             );
119              
120             sub new {
121 9     9 0 72 my $invocant = shift ;
122 9   33     41 my $class = ref($invocant) || $invocant ;
123 9         42 my $self = { %fields, @_ } ;
124 9         24 bless $self, $class ;
125            
126             # only set valid rotors
127 9 100       43 if( defined($self->rotors())){
128 8         9 foreach my $r (@{$self->rotors()}){
  8         28  
129 36 50       40 if(keys(%{$r->cipher()}) == 26){
  36         129  
130             # This rotor is ok
131             } else {
132 0         0 croak("An invalid rotor was provided.");
133             }
134             }
135             } else {
136             # use three default rotors
137 1         5 my $r1 = Crypt::OOEnigma::Rotor->new();
138 1         4 my $r2 = Crypt::OOEnigma::Rotor->new();
139 1         4 my $r3 = Crypt::OOEnigma::Rotor->new();
140 1         7 $self->rotors([$r1, $r2, $r3]);
141             }
142            
143             # only set a valid plugboard
144 9 50       33 if( defined($self->plugboard()) ){
145 0 0       0 if(keys(%{$self->plugboard()->cipher()}) == 26){
  0         0  
146             # This plugboard is ok TODO: improve checking - self-inverse?
147             } else {
148 0         0 croak("An invalid plugboard was provided.");
149             }
150             } else {
151 9         43 $self->plugboard(Crypt::OOEnigma::Plugboard->new());
152             }
153            
154             # Reflector does not require setup
155 9         40 $self->reflector(Crypt::OOEnigma::Reflector->new());
156            
157 9         23 $self->init();
158 9         33 return $self ;
159             }
160              
161             sub init {
162 61     61 0 136 my $self = shift ;
163             # Initialise all the rotors
164 61         82 foreach my $r (@{$self->rotors()}){
  61         200  
165 267         723 $r->init();
166             }
167             # Plugboard and reflector require no initialisation
168             }
169              
170              
171             sub encipher {
172 52     52 0 259471 my $self = shift;
173 52         112 my $work = shift ;
174 52         172 $work =~ s/\s/X/g;
175 52         129 $work = uc($work);
176 52         80 my $result = "";
177 52         70 my @rotors = @{$self->rotors()};
  52         270  
178              
179 52         445 foreach my $ch ( split //, $work ){
180             # pass through plugboard
181 1748         9655 $ch = $self->plugboard()->encode($ch);
182             # encipher in every rotor
183 1748         3925 foreach $r (@rotors){
184 7572         18313 $ch = $r->encode($ch);
185             }
186             # reflect
187 1748         6075 $ch = $self->reflector()->reflect($ch);
188             # reverse encipher in every rotor
189 1748         4136 foreach $r (reverse @rotors){
190 7572         19170 $ch = $r->revencode($ch);
191             }
192             # nudge all the rotors
193 1748         3242 foreach $r (@rotors){
194 7572         17814 $r->next();
195             }
196             # pass through plugboard - self-inverse
197 1748         6470 $ch = $self->plugboard()->encode($ch);
198 1748         4216 $result .= $ch ;
199             }
200              
201 52         403 $self->init();
202 52         311 return $result;
203             }
204              
205             sub AUTOLOAD {
206 5402     5402   6224 my $self = shift;
207             # only access instance methods not class methods
208 5402 50       10239 croak "$self is not an object" unless(ref($self));
209 5402         6196 my $name = our $AUTOLOAD;
210 5402 50       17134 return if($name =~ /::DESTROY/ );
211 5402         16380 $name =~ s/.*://; # strip fully-qualified portion
212 5402 50       16260 unless (exists $self->{$name} ) {
213 0         0 croak "Can't access `$name' field in object of class $self";
214             }
215 5402 100       8688 if (@_) {
216 19         39 return $self->{$name} = shift;
217             } else {
218 5383         20630 return $self->{$name};
219             }
220             }
221              
222             1;