From 6a0022d67d4baea240897c7e3b24d2b864f06c60 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Mon, 29 Aug 2011 18:15:22 +0100
Subject: more stepping tests

---
 lib/Enigmatic/Types.pm | 67 +++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 55 insertions(+), 12 deletions(-)

(limited to 'lib/Enigmatic/Types.pm')

diff --git a/lib/Enigmatic/Types.pm b/lib/Enigmatic/Types.pm
index ed0be32..be5bc87 100644
--- a/lib/Enigmatic/Types.pm
+++ b/lib/Enigmatic/Types.pm
@@ -1,12 +1,21 @@
 package Enigmatic::Types;
 use DAKKAR::p;
-use MooseX::Types -declare => [qw(Letter WiringMap ReflWiringMap RotorPos)];
+use MooseX::Types -declare =>
+    [qw(
+           Letter RotorPos
+           WiringMap ReflWiringMap PlugWiringMap
+           PlugboardT
+           RotorT
+           ReflectorT
+   )];
 use MooseX::Types::Moose qw(Str Int);
 use MooseX::Types::Structured qw(Map);
+use Moose::Util::TypeConstraints;
 
-subtype Letter,
-    as Str,
-    where { /[A-Z]/ };
+subtype Letter, as Str, where { /[A-Z]/ };
+
+subtype RotorPos, as Int, where { $_ >=0 and $_ <= 25 };
+coerce RotorPos, from Letter, via { ord($_) - ord('A') };
 
 subtype WiringMap,
     as Map[Letter,Letter],
@@ -32,14 +41,48 @@ sub _coerce_wiring {
     \%ret;
 }
 
-coerce WiringMap,
-    from Str,
-    via \&_coerce_wiring;
+coerce WiringMap, from Str, via \&_coerce_wiring;
+
+coerce ReflWiringMap, from Str, via \&_coerce_wiring;
 
-coerce ReflWiringMap,
+subtype PlugWiringMap, as ReflWiringMap;
+
+coerce PlugWiringMap,
     from Str,
-    via \&_coerce_wiring;
+    via {
+        my %map = map { $_, $_ } 'A'..'Z';
+
+        my $in = $_; $in =~ s{\s+}{}g;
+        my @pairs = $in->split(qr{(..)})->grep(sub{length})->flatten;
+        for my $pair (@pairs) {
+            my ($from,$to) = ($pair =~ m{(.)(.)});
+
+            croak "useless plug $pair"
+                if $from eq $to;
+            croak "excessive plug in $from"
+                if $map{$from} ne $from;
+            croak "excessive plug in $to"
+                if $map{$to} ne $to;
+            $map{$from} = $to;
+            $map{$to} = $from;
+        }
+        return \%map;
+    };
+
+subtype RotorT, as class_type('Enigmatic::Rotor');
+coerce RotorT, from Str, via {
+    require Enigmatic::RotorBox;
+    Enigmatic::RotorBox->new->get($_)
+  };
+
+subtype ReflectorT, as class_type('Enigmatic::Reflector');
+coerce ReflectorT, from Str, via {
+    require Enigmatic::ReflectorBox;
+    Enigmatic::ReflectorBox->new->get($_)
+  };
 
-subtype RotorPos,
-    as Int,
-    where { $_ >=0 and $_ <= 26 };
+subtype PlugboardT, as class_type('Enigmatic::Plugboard');
+coerce PlugboardT, from Str, via {
+    require Enigmatic::Plugboard;
+    Enigmatic::Plugboard->new($_);
+ };
-- 
cgit v1.2.3