full-machine and tests

1 files changed, 89 insertions, 0 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;
+}