From 1776bd778db4f6ed72eed47602877ab7a8fb904f Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Mon, 29 Aug 2011 13:54:58 +0100
Subject: reflectors, in box, and some refactor

---
 lib/Enigmatic/Reflector.pm       | 21 +++++++++++++++++++++
 lib/Enigmatic/ReflectorBox.pm    | 28 ++++++++++++++++++++++++++++
 lib/Enigmatic/Role/WithWiring.pm | 17 +++++++++++++++++
 lib/Enigmatic/Rotor.pm           | 12 +-----------
 lib/Enigmatic/Types.pm           | 31 ++++++++++++++++++++++---------
 5 files changed, 89 insertions(+), 20 deletions(-)
 create mode 100644 lib/Enigmatic/Reflector.pm
 create mode 100644 lib/Enigmatic/ReflectorBox.pm
 create mode 100644 lib/Enigmatic/Role/WithWiring.pm

(limited to 'lib')

diff --git a/lib/Enigmatic/Reflector.pm b/lib/Enigmatic/Reflector.pm
new file mode 100644
index 0000000..b9371dd
--- /dev/null
+++ b/lib/Enigmatic/Reflector.pm
@@ -0,0 +1,21 @@
+package Enigmatic::Reflector;
+use DAKKAR::p 'class';
+use Enigmatic::Types qw(ReflWiringMap Letter);
+
+has wiring => (
+    is => 'ro',
+    isa => ReflWiringMap,
+    coerce => 1,
+);
+
+with 'Enigmatic::Role::WithWiring';
+
+sub map {
+    my $self = shift;
+    my ($letter) = pos_validated_list(
+        \@_,
+        { isa => Letter },
+    );
+
+    return $self->wiring->at($letter);
+}
diff --git a/lib/Enigmatic/ReflectorBox.pm b/lib/Enigmatic/ReflectorBox.pm
new file mode 100644
index 0000000..eafa667
--- /dev/null
+++ b/lib/Enigmatic/ReflectorBox.pm
@@ -0,0 +1,28 @@
+package Enigmatic::ReflectorBox;
+use DAKKAR::p 'class';
+use Enigmatic::Reflector;
+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')],
+    lazy_build => 1,
+    traits => ['Hash'],
+    handles => {
+        get => 'get',
+    },
+);
+
+sub _build_reflectorset {
+    my %reflectors = (
+        B => 'YRUHQSLDPXNGOKMIEBFZCWVJAT',
+        C => 'FVPJIAOYEDRZXWGCTKUQSBNMHL',
+        'B_thin' => 'ENKQAUYWJICOPBLMDXZVFTHRGS',
+        'C_thin' => 'RDOBJNTKVEHMLFCWZAXGYIPSUQ',
+    );
+
+    $_ = Enigmatic::Reflector->new($_) for values %reflectors;
+    return \%reflectors;
+}
diff --git a/lib/Enigmatic/Role/WithWiring.pm b/lib/Enigmatic/Role/WithWiring.pm
new file mode 100644
index 0000000..df6dc48
--- /dev/null
+++ b/lib/Enigmatic/Role/WithWiring.pm
@@ -0,0 +1,17 @@
+package Enigmatic::Role::WithWiring;
+use DAKKAR::p 'role';
+
+requires 'BUILDARGS';
+requires 'wiring';
+
+around BUILDARGS => sub {
+    my $orig  = shift;
+    my $class = shift;
+
+    if ( @_ == 1 && !ref $_[0] ) {
+        return $class->$orig( wiring => $_[0] );
+    }
+    else {
+        return $class->$orig(@_);
+    }
+};
diff --git a/lib/Enigmatic/Rotor.pm b/lib/Enigmatic/Rotor.pm
index a600b43..792c7b5 100644
--- a/lib/Enigmatic/Rotor.pm
+++ b/lib/Enigmatic/Rotor.pm
@@ -14,17 +14,7 @@ has ring_setting => (
     default => 0,
 );
 
-around BUILDARGS => sub {
-    my $orig  = shift;
-    my $class = shift;
-
-    if ( @_ == 1 && !ref $_[0] ) {
-        return $class->$orig( wiring => $_[0] );
-    }
-    else {
-        return $class->$orig(@_);
-    }
-};
+with 'Enigmatic::Role::WithWiring';
 
 sub map {
     my $self = shift;
diff --git a/lib/Enigmatic/Types.pm b/lib/Enigmatic/Types.pm
index 12cb414..ed0be32 100644
--- a/lib/Enigmatic/Types.pm
+++ b/lib/Enigmatic/Types.pm
@@ -1,6 +1,6 @@
 package Enigmatic::Types;
 use DAKKAR::p;
-use MooseX::Types -declare => [qw(Letter WiringMap RotorPos)];
+use MooseX::Types -declare => [qw(Letter WiringMap ReflWiringMap RotorPos)];
 use MooseX::Types::Moose qw(Str Int);
 use MooseX::Types::Structured qw(Map);
 
@@ -16,16 +16,29 @@ subtype WiringMap,
         $in eq $out and $in eq ['A'..'Z']->join;
     };
 
+subtype ReflWiringMap,
+    as WiringMap,
+    where {
+        my %reverse; @reverse{values %$_} = keys %$_;
+        (join '',@reverse{keys %$_}) eq $_->values->join;
+    };
+
+sub _coerce_wiring {
+    my @out = $_[0]->uc->split(qr//)->flatten;
+    croak "invalid wiring string <$_>"
+        unless @out == 26;
+    my %ret;
+    @ret{'A'..'Z'}=@out;
+    \%ret;
+}
+
 coerce WiringMap,
     from Str,
-    via {
-        my @out = $_->uc->split(qr//)->flatten;
-        croak "invalid wiring string <$_>"
-            unless @out == 26;
-        my %ret;
-        @ret{'A'..'Z'}=@out;
-        \%ret;
-    };
+    via \&_coerce_wiring;
+
+coerce ReflWiringMap,
+    from Str,
+    via \&_coerce_wiring;
 
 subtype RotorPos,
     as Int,
-- 
cgit v1.2.3