File Coverage

blib/lib/Crypt/OOEnigma/Commercial.pm
Criterion Covered Total %
statement 59 61 96.7
branch 8 12 66.6
condition 1 3 33.3
subroutine 8 8 100.0
pod 0 3 0.0
total 76 87 87.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # Commercial.pm
4             #
5             # Copyright (c) 2002 Ambriel Consulting
6             # sjb Mon Mar 18 20:55:53 GMT 2002
7             #
8              
9             package Crypt::OOEnigma::Commercial ;
10             $VERSION="0.3";
11             =head1 NAME
12              
13             Crypt::OOEnigma::Commercial - A commercial Enigma machine circa 1940.
14              
15             =head1 SYNOPSIS
16              
17             use Crypt::OOEnigma::Commercial;
18             my $enigma = new Crypt::OOEnigma::Commercial;
19              
20             # or
21             use Crypt::OOEnigma::Commercial;
22             use Crypt::OOEnigma::Rotor;
23             my @rotors = ();
24             # Populate the list of Crypt::OOEnigma::Rotor
25             Crypt::OOEnigma::Commercial->new( rotors => [@rotors] );
26              
27             # or even
28             use Crypt::OOEnigma::Commercial;
29             use Crypt::OOEnigma::Rotor;
30             use Crypt::OOEnigma::Reflector;
31             my @rotors = ()
32             # Populate the list of Crypt::OOEnigma::Rotor
33             my $reflector = new Crypt:OOEnigma::Reflector(params); # see relevant pod
34             Crypt::OOEnigma::Commercial->new( rotors => [@rotors],
35             reflector => $reflector);
36              
37             my $cipher = $enigma->encipher($mesg);
38             my $decode = $enigma->encipher($cipher); # self-inverse
39              
40             # Also, for use internally:
41             $enigma->init(); # returns the rotors to their initial state
42              
43             =head1 DESCRIPTION
44              
45             This module provides a commercial Enigma machine consisting of a number of
46             rotors and a reflector. If no Rotors are provided in the constructor, 3
47             default Rotors are used, each of which uses an identity substitution (ie no
48             cipher at all in each rotor in start position 0).
49              
50             Normally, you should create your own rotors and use those. See the
51             documentation for Crypt::OOEnigma::Rotor for details.
52              
53             =head1 NOTES
54              
55             None
56              
57             =head1 BUGS and CAVEATS
58              
59             =head2 Enigma is weak!
60              
61             Cryptographers talk of the strength of a cryptographic algorithm in term of
62             whether it is computationally feasible to break it. It is, of course,
63             computationally feasible to break an Enigma cipher so don't use it for
64             anything serious!
65              
66             =head1 HISTORY
67              
68             This package was created in spring 2002 as an exercise in OO Perl and
69             preparing modules properly for CPAN. More importantly, the Enigma is
70             interesting.
71              
72             CPAN already has a Crypt::Enigma which is not object oriented and implements
73             only one Enigma (whereas you can create any Enigma-like machine with these
74             objects). Hence the package name Crypt::OOEnigma
75              
76             =head1 SEE ALSO
77              
78             The Pleasures of Counting, T W Korner, CUP 1996. A great book for anyone with
79             the slightest interest in mathematics
80             ISBN 0 521 56087 X hardback
81             ISBN 0 521 56823 4 paperback
82              
83             Crypt::OOEnigma::Military
84              
85             The components:
86             Crypt::OOEnigma::Rotor
87             Crypt::OOEnigma::Reflector
88             Crypt::OOEnigma::Plugboard
89              
90             =head1 AUTHOR
91              
92             S J Baker, Ambriel Consulting, http://ambrielconsulting.com
93              
94             =head1 COPYRIGHT
95              
96             This package is licenced under the same terms as Perl itself.
97              
98             =cut
99              
100 2     2   65544 use Carp ;
  2         5  
  2         183  
101 2     2   1578 use Crypt::OOEnigma::Rotor ;
  2         9  
  2         55  
102 2     2   1332 use Crypt::OOEnigma::Reflector ;
  2         5  
  2         78  
103              
104              
105             # use Autoloading for accessors
106 2     2   11 use subs qw(rotors reflector);
  2         9  
  2         10  
107              
108             my %fields = (
109             rotors => undef,
110             reflector => undef
111             );
112              
113             sub new {
114 9     9 0 81 my $invocant = shift ;
115 9   33     44 my $class = ref($invocant) || $invocant ;
116 9         42 my $self = { %fields, @_ } ;
117 9         31 bless $self, $class ;
118            
119             # only set valid rotors
120 9 100       44 if( defined($self->rotors())){
121 8         11 foreach my $r (@{$self->rotors()}){
  8         27  
122 36 50       41 if(keys(%{$r->cipher()}) == 26){
  36         136  
123             # This rotor is ok
124             } else {
125 0         0 croak("An invalid rotor was provided.");
126             }
127             }
128             } else {
129             # use three default rotors (identity substitution!)
130 1         5 my $r1 = Crypt::OOEnigma::Rotor->new();
131 1         7 my $r2 = Crypt::OOEnigma::Rotor->new();
132 1         4 my $r3 = Crypt::OOEnigma::Rotor->new();
133 1         9 $self->rotors([$r1, $r2, $r3]);
134             }
135            
136             # Reflector does not require setup
137 9         57 $self->reflector(Crypt::OOEnigma::Reflector->new());
138            
139 9         24 $self->init();
140 9         49 return $self ;
141             }
142              
143             sub init {
144 61     61 0 115 my $self = shift ;
145             # Initialise all the rotors
146 61         102 foreach my $r (@{$self->rotors()}){
  61         218  
147 267         851 $r->init();
148             }
149             }
150              
151             sub encipher {
152 52     52 0 243177 my $self = shift;
153 52         96 my $work = shift;
154 52         156 $work =~ s/\s/X/g;
155 52         127 $work = uc($work);
156 52         82 my $result = "";
157 52         76 my @rotors = @{$self->rotors()};
  52         311  
158              
159 52         452 foreach my $ch ( split //, $work ){
160             # encipher in every rotor
161 1748         2978 foreach $r (@rotors){
162 7572         18964 $ch = $r->encode($ch);
163             }
164             # reflect
165 1748         6049 $ch = $self->reflector()->reflect($ch);
166             # reverse encipher in every rotor
167 1748         3919 foreach $r (reverse @rotors){
168 7572         18021 $ch = $r->revencode($ch);
169             }
170             # nudge all the rotors
171 1748         3017 foreach $r (@rotors){
172 7572         18799 $r->next();
173             }
174 1748         3231 $result .= $ch ;
175             }
176              
177 52         384 $self->init();
178 52         327 return $result;
179             }
180              
181             sub AUTOLOAD {
182 1888     1888   2355 my $self = shift;
183             # only access instance methods not class methods
184 1888 50       3816 croak "$self is not an object" unless(ref($self));
185 1888         2356 my $name = our $AUTOLOAD;
186 1888 50       4292 return if($name =~ /::DESTROY/ );
187 1888         5617 $name =~ s/.*://; # strip fully-qualified portion
188 1888 50       4161 unless (exists $self->{$name} ) {
189 0         0 croak "Can't access `$name' field in object of class $self";
190             }
191 1888 100       6593 if (@_) {
192 10         23 return $self->{$name} = shift;
193             } else {
194 1878         7152 return $self->{$name};
195             }
196             }
197              
198             1;
199