File Coverage

blib/lib/Crypt/OOEnigma/Plugboard.pm
Criterion Covered Total %
statement 22 24 91.6
branch 4 8 50.0
condition 1 3 33.3
subroutine 5 5 100.0
pod 0 2 0.0
total 32 42 76.1


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # Plugboard.pm
4             #
5             # Copyright (c) 2002 Ambriel Consulting
6             # sjb Sun Mar 17 20:43:56 GMT 2002
7             #
8              
9             package Crypt::OOEnigma::Plugboard ;
10             $VERSION="0.3";
11             =head1 NAME
12              
13             Crypt::OOEnigma::Plugboard - The Plugboard object for use in Crypt::OOEnigmas
14              
15             =head1 SYNOPSIS
16              
17             my $plugboard = Crypt::OOEnigma::Plugboard->new();
18              
19             # OR
20             my $subHash ={ # The identity cipher with a few pairs of letters swapped
21             A => "B",
22             B => "A",
23             # etc
24             };
25             my $plugboard = Crypt::OOEnigma::Plugboard->new(cipher => $subHash);
26              
27             # for internal use bu Enigma machines
28             my $cipher-letter = $plugboard->encode($some-clear-text-letter);
29              
30             =head1 DESCRIPTION
31              
32             This is the Plugboard for use in Crypt::OOEnigmas. Use it when you want to
33             create your own Enigmas with specific properties.
34              
35             =head1 NOTES
36              
37             None
38              
39             =head1 BUGS and CAVEATS
40              
41             =head2 Enigma is weak!
42              
43             Cryptographers talk of the strength of a cryptographic algorithm in term of
44             whether it is computationally feasible to break it. It is, of course,
45             computationally feasible to break an Enigma cipher so don't use it for anything
46             serious!
47              
48             =head1 HISTORY
49              
50             This package was created in spring 2002 as an exercise in OO Perl and preparing
51             modules properly for CPAN. More importantly, the Enigma is interesting.
52              
53             CPAN already has a Crypt::Enigma which is not object oriented and implements
54             only one Enigma (whereas you can create any Enigma-like machine with these
55             objects). Hence the package name Crypt::OOEnigma
56              
57             =head1 SEE ALSO
58              
59             The Pleasures of Counting, T W Korner, CUP 1996. A great book for anyone with
60             the slightest interest in mathematics:
61             ISBN 0 521 56087 X hardback
62             ISBN 0 521 56823 4 paperback
63              
64             The Enigmas:
65             Crypt::OOEnigma::Military
66             Crypt::OOEnigma::Commercial
67              
68             The components:
69             Crypt::OOEnigma::Rotor
70             Crypt::OOEnigma::Reflector
71             Crypt::OOEnigma::Plugboard
72              
73             =head1 AUTHOR
74              
75             S J Baker, Ambriel Consulting, http://ambrielconsulting.com
76              
77             =head1 COPYRIGHT
78              
79             This package is licenced under the same terms as Perl itself.
80              
81             =cut
82 2     2   9 use Carp ;
  2         4  
  2         489  
83              
84             # create a default plugboard
85             my $subst = {};
86             my @alpha = (A..Z);
87              
88             CIPHER: {
89             # Initially the identity
90             foreach my $val (@alpha){
91             $subst->{$val} = $val ;
92             }
93             # Then we interchange 6 pairs of letters
94             $subst->{A}="M";
95             $subst->{M}="A";
96             $subst->{C}="P";
97             $subst->{P}="C";
98             $subst->{E}="R";
99             $subst->{R}="E";
100             $subst->{G}="V";
101             $subst->{V}="G";
102             $subst->{H}="D";
103             $subst->{D}="H";
104             $subst->{K}="X";
105             $subst->{X}="K";
106             }
107              
108             my %fields = (
109             cipher => $subst,
110             );
111              
112             # use Autoloading for accessors
113 2     2   16 use subs qw(cipher);
  2         8  
  2         10  
114              
115             sub new {
116 9     9 0 12 my $invocant = shift ;
117 9   33     36 my $class = ref($invocant) || $invocant ;
118 9         27 my $self = { %fields, @_ } ;
119 9         22 bless $self, $class ;
120 9         38 return $self ;
121             }
122              
123             sub encode {
124 3496     3496 0 4095 my $self = shift;
125 3496         4287 my $source = shift;
126 3496         9895 return $self->cipher()->{$source};
127             }
128              
129             sub AUTOLOAD {
130 3496     3496   4107 my $self = shift;
131             # only access instance methods not class methods
132 3496 50       6838 croak "$self is not an object" unless(ref($self));
133 3496         4060 my $name = our $AUTOLOAD;
134 3496 50       6804 return if($name =~ /::DESTROY/ );
135 3496         8585 $name =~ s/.*://; # strip fully-qualified portion
136 3496 50       7317 unless (exists $self->{$name} ) {
137 0         0 croak "Can't access `$name' field in object of class $self";
138             }
139 3496 50       5094 if (@_) {
140 0         0 return $self->{$name} = shift;
141             } else {
142 3496         13355 return $self->{$name};
143             }
144             }
145              
146             1;