full-machine and tests

7 files changed, 239 insertions, 3 deletions

diff --git a/lib/Enigmatic/Machine.pm b/lib/Enigmatic/Machine.pm
new file mode 100644
index 0000000..f5d5081
--- /dev/null
+++ b/lib/Enigmatic/Machine.pm
@@ -0,0 +1,89 @@
+package Enigmatic::Machine;
+use DAKKAR::p 'class';
+use Enigmatic::RotorBox;
+use Enigmatic::ReflectorBox;
+use Enigmatic::Plugboard;
+use Enigmatic::CryptTrain;
+use Enigmatic::Types qw(Letter RotorT ReflectorT PlugboardT);
+use MooseX::Types::Moose qw(ArrayRef Str);
+
+has train => (
+    isa => 'Enigmatic::CryptTrain',
+    is => 'ro',
+);
+
+has plugboard => (
+    isa => PlugboardT,
+    is => 'ro',
+    default => sub { Enigmatic::Plugboard->new },
+    coerce => 1,
+);
+
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $class = shift;
+
+    my $args = $class->$orig(@_);
+
+    croak "no rotors specified" unless $args->{rotors};
+    croak "no reflector specified" unless $args->{reflector};
+
+    my $rotors = $args->{rotors}->map(\&to_RotorT);
+    my $reflector = to_ReflectorT($args->{reflector});
+
+    if ($args->{ring_settings}) {
+        $args->{ring_settings}->each(
+            sub {
+                my ($idx,$setting) = @_;
+                $rotors->[$idx]->ring_setting($setting);
+            });
+    }
+
+    $args->{train} = Enigmatic::CryptTrain->new({
+        rotors => $rotors,
+        reflector => $reflector,
+        ( $args->{rotor_positions} ? ( positions => $args->{rotor_positions} ) : () ),
+    });
+
+    return $args;
+};
+
+sub map {
+    my $self = shift;
+    my ($letter) = pos_validated_list(
+        \@_,
+        { isa => Letter },
+    );
+
+warn "mapping $letter\n";
+warn " initial positions: @{[ $self->train->positions ]}\n";
+
+    $letter = $self->plugboard->map($letter);
+
+warn " after plugboard: $letter\n";
+
+    $letter = $self->train->map($letter);
+
+warn " after rotors: $letter\n";
+
+    $letter = $self->plugboard->map($letter);
+
+warn " after plugboard: $letter\n";
+
+warn " new positions: @{[ $self->train->positions ]}\n";
+
+    return $letter;
+}
+
+sub map_string {
+    my ($self,$string) = @_;
+
+    my @letters = $string->split(qr//)->grep(\&is_Letter)->flatten;
+
+    my @res;
+    for my $letter (@letters) {
+        push @res, $self->map($letter);
+    }
+
+    return wantarray ? @res : @res->join;
+}
diff --git a/lib/Enigmatic/ReflectorBox.pm b/lib/Enigmatic/ReflectorBox.pm
index eafa667..e0558cf 100644
--- a/lib/Enigmatic/ReflectorBox.pm
+++ b/lib/Enigmatic/ReflectorBox.pm
@@ -1,13 +1,14 @@
 package Enigmatic::ReflectorBox;
 use DAKKAR::p 'class';
 use Enigmatic::Reflector;
+use Enigmatic::Types 'ReflectorT';
 use MooseX::Types::Structured qw(Map);
 use MooseX::Types::Moose qw(Str);
 use Moose::Util::TypeConstraints;
 
 has reflectorset => (
     is => 'ro',
-    isa => Map[Str,class_type('Enigmatic::Reflector')],
+    isa => Map[Str,ReflectorT],
     lazy_build => 1,
     traits => ['Hash'],
     handles => {
diff --git a/lib/Enigmatic/RotorBox.pm b/lib/Enigmatic/RotorBox.pm
index 57f0a47..caf7ed1 100644
--- a/lib/Enigmatic/RotorBox.pm
+++ b/lib/Enigmatic/RotorBox.pm
@@ -1,13 +1,14 @@
 package Enigmatic::RotorBox;
 use DAKKAR::p 'class';
 use Enigmatic::Rotor;
+use Enigmatic::Types 'RotorT';
 use MooseX::Types::Structured qw(Map);
 use MooseX::Types::Moose qw(Str);
 use Moose::Util::TypeConstraints;
 
 has rotorset => (
     is => 'ro',
-    isa => Map[Str,class_type('Enigmatic::Rotor')],
+    isa => Map[Str,RotorT],
     lazy_build => 1,
     traits => ['Hash'],
     handles => {
@@ -26,7 +27,7 @@ sub _build_rotorset {
         VII => { wiring => 'NZJHGRCXMYSWBOUFAIVLPEKQDT', notches => ['M','Z'] },
         VIII => { wiring => 'FKQHTLXOCBJSPDZRAMEWNIUYGV', notches => ['M','Z'] },
         Beta => { wiring => 'LEYJVCNIXWPBQMDRTAKZGFUHOS', notches => [] },
-        Gamma => { wiring => 'FSOKANUERHMBTIYCWLQPZXVGJD', notches => [''] },
+        Gamma => { wiring => 'FSOKANUERHMBTIYCWLQPZXVGJD', notches => [] },
     );
 
     $_ = Enigmatic::Rotor->new($_) for values %rotors;
diff --git a/t/basic-enigma.t b/t/basic-enigma.t
new file mode 100644
index 0000000..0760737
--- /dev/null
+++ b/t/basic-enigma.t
@@ -0,0 +1,28 @@
+#!perl
+use DAKKAR::p 'test';
+use Test::Enigmatic;
+use Enigmatic::Machine;
+
+Test::Enigmatic::test_full_machine(
+    sub {
+        Enigmatic::Machine->new({
+            reflector => 'B',
+            rotors => [ 'III', 'II', 'I' ],
+        });
+    },
+    'AAAAA',
+    'BDZGO');
+
+Test::Enigmatic::test_full_machine(
+    sub {
+        Enigmatic::Machine->new({
+            reflector => 'B',
+            rotors => [ 'III', 'II', 'I' ],
+            ring_settings => ['B','B','B'],
+        });
+    },
+    'AAAAA',
+    'EWTYX');
+
+
+done_testing();
diff --git a/t/full-enigma.t b/t/full-enigma.t
new file mode 100644
index 0000000..0015b46
--- /dev/null
+++ b/t/full-enigma.t
@@ -0,0 +1,69 @@
+#!perl
+use DAKKAR::p 'test';
+
+use Enigmatic::Machine;
+
+sub real_machine {
+    return  Enigmatic::Machine->new({
+        reflector => 'B_thin',
+        rotors => [ 'I', 'IV', 'II', 'Beta' ],
+        plugboard => 'AT BL DF GJ HM NW OP QY RZ VX',
+        ring_settings => [ 'V', 'A', 'A', 'A' ],
+        rotor_positions => [ 'A', 'N', 'J', 'V' ],
+    });
+}
+
+my $plaintext = <<'EOPLAIN';
+VONV ONJL OOKS JHFF TTTE
+INSE INSD REIZ WOYY QNNS
+NEUN INHA LTXX BEIA NGRI
+FFUN TERW ASSE RGED RUEC
+KTYW ABOS XLET ZTER GEGN
+ERST ANDN ULAC HTDR EINU
+LUHR MARQ UANT ONJO TANE
+UNAC HTSE YHSD REIY ZWOZ
+WONU LGRA DYAC HTSM YSTO
+SSEN ACHX EKNS VIER MBFA
+ELLT YNNN NNNO OOVI ERYS
+ICHT EINS NULL
+EOPLAIN
+$plaintext =~ s{\s+}{}g;
+
+my $ciphertext = <<'EOCIPHER';
+NCZW VUSX PNYM INHZ XMQX
+SFWX WLKJ AHSH NMCO CCAK
+UQPM KCSM HKSE INJU SBLK
+IOSX CKUB HMLL XCSJ USRR
+DVKO HULX WCCB GVLI YXEO
+AHXR HKKF VDRE WEZL XOBA
+FGYU JQUK GRTV UKAM EURB
+VEKS UHHV OYHA BCJW MAKL
+FKLM YFVN RIZR VVRT KOFD
+ANJM OLBG FFLE OPRG TFLV
+RHOW OPBE KVWM UQFM PWPA
+RMFH AGKX IIBG
+EOCIPHER
+$ciphertext =~ s{\s+}{}g;
+
+note "encrypt real";
+
+my $check = real_machine->map_string($plaintext);
+p $check;
+is($check,$ciphertext,
+   'ok crypt');
+
+note "round-trip check";
+
+$check = real_machine->map_string($check);
+p $check;
+is($check,$plaintext,
+   'round tripped');
+
+note "decrypt real";
+
+$check = real_machine->map_string($ciphertext);
+p $check;
+is($check,$plaintext,
+   'ok plain');
+
+
diff --git a/t/lib/Test/Enigmatic.pm b/t/lib/Test/Enigmatic.pm
index 923ede1..9958667 100644
--- a/t/lib/Test/Enigmatic.pm
+++ b/t/lib/Test/Enigmatic.pm
@@ -13,3 +13,28 @@ sub test_static_map {
            "$name on $c");
     }
 }
+
+
+sub test_full_machine {
+    my ($factory,$input,$exp_output) = @_;
+
+    $input =~ s{\s+}{}g;
+
+    my $output = $factory->()->map_string(uc $input);
+
+    note "output: $output";
+
+    my $back = $factory->()->map_string($output);
+
+    note "back: $back";
+
+    is($back,
+       $input,
+       'round tripped');
+    if ($exp_output) {
+        $exp_output =~ s{\s+}{}g;
+        is($output,
+           uc($exp_output),
+           'got expected output');
+    }
+}
diff --git a/t/simple-enigma.t b/t/simple-enigma.t
new file mode 100644
index 0000000..b2bcbdd
--- /dev/null
+++ b/t/simple-enigma.t
@@ -0,0 +1,23 @@
+#!perl
+use DAKKAR::p 'test';
+
+use Enigmatic::Machine;
+
+sub real_machine {
+    return  Enigmatic::Machine->new({
+        reflector => 'B_thin',
+        rotors => [ 'I', 'IV', 'II', 'Beta' ],
+        plugboard => 'AT BL DF GJ HM NW OP QY RZ VX',
+        ring_settings => [ 'V', 'A', 'A', 'A' ],
+        rotor_positions => [ 'A', 'N', 'J', 'V' ],
+    });
+}
+
+my $plaintext = 'this is a simple text to be encrypted by an enigma machine'->uc;
+note "encrypt simple";
+my $ciphertext = real_machine->map_string($plaintext);note $ciphertext;
+note "decrypt simple";
+my $check = real_machine->map_string($ciphertext);note $check;
+$plaintext =~ s{\s+}{}g;
+is($check,$plaintext,
+   'round tripped');