From 24dedb2618abc80efc2af10de597d1debbeba69f Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Mon, 29 Aug 2011 14:49:07 +0100
Subject: crypto train, with some stepping

---
 lib/Enigmatic/CryptTrain.pm | 86 +++++++++++++++++++++++++++++++++++++++++++++
 t/stepping.t                | 31 ++++++++++++++++
 2 files changed, 117 insertions(+)
 create mode 100644 lib/Enigmatic/CryptTrain.pm
 create mode 100644 t/stepping.t

diff --git a/lib/Enigmatic/CryptTrain.pm b/lib/Enigmatic/CryptTrain.pm
new file mode 100644
index 0000000..06a11d2
--- /dev/null
+++ b/lib/Enigmatic/CryptTrain.pm
@@ -0,0 +1,86 @@
+package Enigmatic::CryptTrain;
+use DAKKAR::p 'class';
+use Enigmatic::Types qw(Letter RotorPos);
+use MooseX::Types::Moose qw(ArrayRef);
+use Moose::Util::TypeConstraints;
+
+has rotors => (
+    isa => ArrayRef[class_type('Enigmatic::Rotor')],
+    traits => ['Array'],
+    writer => 'set_rotors',
+    handles => {
+        set_rotor => 'set',
+        rotor_at => 'get',
+        rotors => 'elements',
+    },
+);
+
+sub rotor_count {
+    my ($self) = @_;
+
+    return scalar $self->rotors;
+}
+
+has reflector => (
+    isa => class_type('Enigmatic::Reflector'),
+    writer => 'set_reflector',
+    reader => 'reflector',
+);
+
+has positions => (
+    isa => ArrayRef[RotorPos],
+    traits => ['Array'],
+    writer => 'set_positions',
+    handles => {
+        set_position => 'set',
+        position_at => 'get',
+        positions => 'elements',
+    },
+);
+
+sub map {
+    my $self = shift;
+    my ($letter) = pos_validated_list(
+        \@_,
+        { isa => Letter },
+    );
+
+    for my $element (
+        $self->rotors,
+        $self->reflector,
+        (reverse $self->rotors),
+    ) {
+        $letter = $element->map($letter);
+    }
+    $self->step_positions();
+
+    return $letter;
+}
+
+sub _inc_position {
+    my ($self,$idx) = @_;
+
+    my $cur = $self->position_at($idx);
+    $cur = ($cur+1)%26;
+    $self->set_position($idx,$cur);
+    return $cur;
+}
+
+sub rotor_window_at {
+    my ($self,$idx) = @_;
+
+    return ['A'..'Z']->[$self->position_at($idx)]
+}
+
+sub step_positions {
+    my ($self) = @_;
+
+    for my $pos (0 .. $self->rotor_count -1) {
+        $self->_inc_position($pos);
+        my $rot = $self->rotor_at($pos);
+        last
+            unless $rot->has_notch_at($self->rotor_window_at($pos));
+    }
+
+    return;
+}
diff --git a/t/stepping.t b/t/stepping.t
new file mode 100644
index 0000000..f50bce9
--- /dev/null
+++ b/t/stepping.t
@@ -0,0 +1,31 @@
+#!perl
+use DAKKAR::p 'test';
+
+use Enigmatic::Rotor;
+use Enigmatic::Reflector;
+use Enigmatic::CryptTrain;
+
+subtest 'first position' => sub {
+    my @in = 'A'..'Z';
+
+    my @rots = map { Enigmatic::Rotor->new(@in->join) } 1..3;
+    my $refl = Enigmatic::Reflector->new(@in->join);
+    my $train = Enigmatic::CryptTrain->new({
+        rotors => \@rots,
+        reflector => $refl,
+        positions => [0,0,0],
+    });
+
+    my $pos=0;
+    for my $c ('A' .. 'Z') {
+        is($train->map($c),
+           $c,
+           "identity train on $c");
+        ++$pos;$pos%=26;
+        is_deeply([$train->positions],
+                  [$pos,0,0],
+                  'no notches, only 1st moved');
+    }
+};
+
+done_testing();
-- 
cgit v1.2.3