summaryrefslogtreecommitdiff
path: root/lib/Enigmatic/Types.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Enigmatic/Types.pm')
-rw-r--r--lib/Enigmatic/Types.pm67
1 files changed, 55 insertions, 12 deletions
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($_);
+ };